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