Genau so etwas habe ich gesucht, daher habe ich den Code kopiert und in ein Modul gepackt, dann aber beim Start des Makros, bricht es ab und gibt den unten genannten Fehler an.
Kann mir bitte jemand den Code vervollständigen, denn er ist offensichtlich fehlerhaft.
Danke vorab und Gruß von RalfF
Der Code läuft bis an diese Stelle
Set wksMy = ThisWorkbook.Worksheets("Feiertage")
und bricht dann ab.
So habe ich ich es bei Herber gefunden :
Jahreskalender mit Monatsblättern anlegen
Problem: Wie kann ich auf Buttondruck einen kompletten Jahreskalender mit 12 Monatsblättern anlegen? Samstage, Sonntage und Feiertage, einschließlich der beweglichen, sollen markiert werden.
Lösung: Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
Sub Main()
Dim wks As Worksheet
Dim cmt As Comment
Dim vYear As Variant
Dim iRow As Integer
Dim bln As Boolean
Application.ScreenUpdating = False
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Set wks = ActiveSheet
vYear = InputBox( _
prompt:="Gewünschtes Kalenderjahr angeben:", _
Default:=Year(Date))
Range("C1").Value = CInt(vYear)
Workbooks.Add 1
Call MonateAnlegen
Call TageEintragen
iRow = 1
Do Until IsEmpty(wks.Cells(iRow, 1))
With Worksheets(Month(wks.Cells(iRow, 2).Value))
With .Cells(Day(wks.Cells(iRow, 2).Value), 1)
.Interior.ColorIndex = 36
Set cmt = .AddComment(wks.Cells(iRow, 1).Value)
cmt.Shape.TextFrame.AutoSize = True
End With
End With
iRow = iRow + 1
Loop
Application.DisplayStatusBar = bln
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Private Sub MonateAnlegen()
Dim iMonth As Integer
For iMonth = 1 To 12
If iMonth > 1 Then
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
End If
ActiveSheet.Name = Format( _
DateSerial(Range("C1").Value, iMonth, 1), "mmmm")
Next iMonth
End Sub
Private Sub TageEintragen()
Dim wks As Worksheet, wksMy As Worksheet
Dim lDay As Long
Dim iMonth As Integer, iDay As Integer
Set wksMy = ThisWorkbook.Worksheets("Feiertage")
For iMonth = 1 To 12
Set wks = Worksheets(iMonth)
Application.StatusBar = "Bearbeite Monat " & wks.Name
wks.Columns(1).NumberFormat = "dd.mm.yy"
wks.Columns(2).NumberFormat = "dddd"
For lDay = DateSerial(wksMy.Range("C1").Value, iMonth, 1) To _
DateSerial(wksMy.Range("C1").Value, iMonth + 1, 0)
iDay = iDay + 1
wks.Cells(iDay, 1) = lDay
wks.Cells(iDay, 2) = lDay
If WeekDay(lDay) = 7 Then
wks.Cells(iDay, 1).Interior.ColorIndex = 34
wks.Cells(iDay, 2).Interior.ColorIndex = 34
ElseIf WeekDay(lDay) = 1 Then
wks.Cells(iDay, 1).Interior.ColorIndex = 35
wks.Cells(iDay, 2).Interior.ColorIndex = 35
End If
Next lDay
iDay = 0
Next iMonth
Worksheets(1).Select
ActiveWindow.Caption = "Jahreskalender " & wksMy.Range("C1").Value
End Sub
Function Ostern(iYear As Integer)
Dim iDay As Integer
iDay = (((255 - 11 * (iYear Mod 19)) - 21) Mod 30) + 21
Ostern = DateSerial(iYear, 3, 1) + iDay + (iDay > 48) + _
6 - ((iYear + iYear \ 4 + iDay + (iDay > 48) + 1) Mod 7)
End Function