Option Explicit
Sub KalenderEinfügen() 'Jahreskalenderblatt
Dim Z, S, Year, Month, Day
Dim Eingabe As String
Dim erg%
Eingabe = InputBox("Bitte gib die Jahreszahl ein:", "Jahreskalender")
If IsNumeric(Eingabe) And Eingabe > "2000" And Eingabe Year = Eingabe
Else
erg = MsgBox("Jahreszahl ist ungültig.", vbCritical, "Nur Zahlen eingeben")
End
End If
Cells(1, 1) = Year
Z = 1
S = 1
'Formatierungen und Ausgangswerte
Range(Cells(Z, S + 1), Cells(Z, S + 12)).NumberFormat = "MMM"
Range(Cells(Z, S + 1), Cells(Z, S + 12)).HorizontalAlignment = xlCenter
Range(Cells(Z + 1, S), Cells(Z + 31, S)).NumberFormat = "0""."""
Range(Cells(Z + 1, S), Cells(Z + 31, S + 12)).HorizontalAlignment = xlLeft
Range(Cells(Z + 1, S + 1), Cells(Z + 31, S + 12)).NumberFormat = "DDD"
Range(Cells(Z, S), Cells(Z + 31, S + 12)).Borders.ColorIndex = 1
Range(Cells(Z, S), Cells(Z + 31, S + 12)).Interior.ColorIndex = 0
Range(Cells(Z + 1, S), Cells(Z + 31, S + 12)).Formula = ""
'Felder ausfüllen
For Month = 1 To 12
Cells(Z, S + Month) = CDate(1 & "." & Month & "." & Year)
For Day = 1 To 31
Cells(Z + Day, S) = Day
If IsDate(Day & "." & Month & "." & Year) Then
Cells(Z + Day, S + Month) = CDate(Day & "." & Month & "." & Year)
If Weekday(Cells(Z + Day, S + Month)) = 1 Then
Cells(Z + Day, S + Month).Interior.ColorIndex = 48
ElseIf Weekday(Cells(Z + Day, S + Month)) = 7 Then
Cells(Z + Day, S + Month).Interior.ColorIndex = 15
End If
End If
Next
Next
End Sub