< návrat zpět

MS Excel


Téma: Automatické generování Worksheets rss

Zaslal/a 11.10.2014 12:35

Zdravím,
rád bych věděl, zda je možné generovat worksheety automaticky podle počtu pracovních dní v zadaném měsíci.Tzn. Do sheetu 1 buňka A1 zadám aktuální měsíc, třeba 10 a na základě toho se mi vygenerují worksheety 01 - 31.10

Děkuji předem

Zaslat odpověď >

Strana:  1 2   další »
#021849
Opičák
Samozřejmě že lze. Buď celý kalendář měsíce nebo s vyznačením pracovních dnů, svátků a kde čeho možného nebo jen pracovní dny.
V tomto směru neexistuje téměř žádné omezení.citovat
#021850
avatar
A můžeš mi poradit jak to udělat?

Opičák napsal/a:

Samozřejmě že lze. Buď celý kalendář měsíce nebo s vyznačením pracovních dnů, svátků a kde čeho možného nebo jen pracovní dny.
V tomto směru neexistuje téměř žádné omezení.
citovat
#021853
avatar
Tady je makro co to provede,
Podle potřeb si pouprav.

Sub CountDayMonth()
Dim Feb As Byte, Month As Byte,i As Byte

Month = Range("A1")

If (Format(Now, "yyyy") / 4) = (Format(Now, "yyyy") \ 4) Then
Feb = 29
Else
Feb = 28
End If

GetMonth = Choose(Month, 31, Feb, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)

For i = 1 To GetMonth
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Format(i, "00") & "." & Format(Month, "00")
Next i
End Sub
citovat
#021855
Opičák
V podstatě to samé, jako Cmuch1 s nepatrnými změnami a doplněním barvy karet.
Příloha: zip21855_list_den-mesice.zip (27kB, staženo 45x)
citovat
#021856
avatar
Kluci děkuju moc, oboum to funguje parádně, jen mě ne 1
Takže jestli Vás mohu poprosit o korekci.

Sheet 1 je master, kde je udělaná tabulka atd.
Tam vyplním číslo měsíce,na základě kterého se mi přepočítá v sheetu datum a vypíše den.To mi funguje.
Po spuštění makra potřebuju aby se ten celý list zkopíroval do následujících záložek podle následujícího datumu.Tzn: Sheet 1 bude 01.10.14 a generování bude od 02 - 31.10.14 včetně obsahu sheetu 1 ale s tím, že se změní i datum v B7.
Protože nejsem v ČR tak pátky se musí vypustit takže pracovní dny jsou sobota - čtvrtek.
Takže název listu musí být dd.mm.yy, nemusí být barevný(ale je to hezké, díky opičáku!!!)

Zjistil jsem, že na tohle jsem úplně levej a ať zkouším cokoliv tak mám výpis všech možných errorů jen ne to co bych chtěl 6

Jestli mi můžete pomoct, budu Vám zauzlován!!!
Příloha: zip21856_test-daily-activity-log-10-14.zip (14kB, staženo 33x)
citovat
#021858
avatar
Trochu poupraveno, vložit do obyčejného modulu (ne modulu listu) ve vba.

Sub CopyDayMonth()
Dim Feb As Byte, Month As Byte, i As Byte

Application.ScreenUpdating = False

Month = Range("B2")

If (Format(Now, "yyyy") / 4) = (Format(Now, "yyyy") \ 4) Then
Feb = 29
Else
Feb = 28
End If

GetMonth = Choose(Month, 31, Feb, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)

For i = 2 To GetMonth
Sheets(Sheets.Count).Copy After:=Sheets(i - 1)
Sheets(Sheets.Count).Name = Format(i, "00") & "." & Format(Month, "00") & "." & Format(Range("B7"), "yy")
Range("B7").Formula = "=DATE(" & Format(Range("B7"), "yyyy") & ",B2," & i & ")"
Calculate
Next i
Sheets(1).Select

Application.ScreenUpdating = True

End Sub
citovat
#021860
avatar
Jsi génius, funguje to skvěle!!! Jam mám ještě udělat aby mi to negenerovalo list který připadá na pátek?citovat
#021861
Opičák
Jenom nepodstatné upozornění:
výpočet:
If (Format(Now, "yyyy") / 4) = (Format(Now, "yyyy") \ 4) Then
Feb = 29
Else
Feb = 28
End If

dává špatný výsledek v roce 2100, ale to nám asi nikomu vadit nebude. 9citovat
#021862
€Ł мσşqμΐτσ
dovolil jsem si do makra od @cmuch1 vložit řadek pro eliminaci pátku 1 . Snad to nebude vadit. 10

Sub CopyDayMonth()
Dim dtm As Variant
Dim Feb As Byte, Month As Byte, i As Byte

Application.ScreenUpdating = False
Month = Range("B2")

If (Format(Now, "yyyy") / 4) = (Format(Now, "yyyy") \ 4) Then
Feb = 29
Else
Feb = 28
End If
GetMonth = Choose(Month, 31, Feb, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)

For i = 2 To GetMonth
dtm = Format(i, "00") & "." & Format(Month, "00") & "." & Format(Range("B7"), "yy")
If Not Weekday(CDate(dtm), vbMonday) = 5 Then
'5 se rovná pátek alespon tady v ČR :-D

Sheets(Sheets.Count).Copy After:=Sheets(ThisWorkbook.Sheets.Count)
Sheets(Sheets.Count).Name = dtm
Range("B7").Formula = "=DATE(" & Format(Range("B7"), "yyyy") & ",B2," & i & ")"
Calculate
End If
Next i
Sheets(1).Select
Application.ScreenUpdating = True
End Sub
citovat
#021863
avatar
to mosquito791

Pokus skvělý, jen při debuggingu to napíše CDate type mismatch
Asi tam bude nějaká chybička.

PS : Kluci, díky Vám moc za pomoc, moc si toho vážím.citovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje