Sub Kalender_erstellen()
Dim tag As Long
Dim Monat As Integer
Dim jahr As Integer
Dim ersterTag As Date
Dim letzterTag As Date
Dim zeile As Long
Dim spalte As Long
jahr = 2018
Application.ScreenUpdating = False
For Monat = 1 To 12
spalte = 5
With Sheets(Format(DateSerial(jahr, Monat, 1), "MMMM"))
With .Range("A2:AM99")
.ClearContents
.Interior.ColorIndex = xlNone
.EntireColumn.Hidden = False
End With
With .Range("E1:AJ1")
.ClearContents
.Interior.ColorIndex = xlNone
End With
zeile = 1
ersterTag = CDate("01." & Monat & "." & jahr)
letzterTag = DateSerial(Year(ersterTag), Month(ersterTag) + 1, 0)
.Cells(zeile, spalte) = ersterTag
For tag = ersterTag To letzterTag
.Cells(zeile, spalte) = tag
If Weekday(tag, vbMonday) < 6 Then
With .Columns(spalte)
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.ColumnWidth = 6.71
End With
ElseIf Weekday(tag, vbMonday) = 6 Then
With .Columns(spalte)
.Interior.ColorIndex = 48
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
ElseIf Weekday(tag, vbMonday) = 7 Then
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
End If
Select Case tag
Case DateSerial(Year(tag), 1, 1) 'Neujahr
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 1, 6) 'Hl. drei Könige
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case Ostern(Year(tag)) - 2 'Karfreitag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case Ostern(Year(tag)) 'Ostersonntag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case Ostern(Year(tag)) + 1 'Ostermontag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 5, 1) 'Maifeiertag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case Ostern(Year(tag)) + 39 'Christi Himmelfahrt
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case Ostern(Year(tag)) + 49 'Pfingstsonntag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case Ostern(Year(tag)) + 50 'Pfingstmontag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case Ostern(Year(tag)) + 60 'Fronleichnam
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 8, 15) 'Maria Himmelfahrt
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 10, 3) 'Tag der D. Einheit
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 11, 1) 'Allerheiligen
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 12, 24) 'Heiliger Abend
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 12, 25) '1. Weihnachtstag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 12, 26) '2. Weihnachtstag
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
Case DateSerial(Year(tag), 12, 31) 'Sylvester
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
End Select
spalte = spalte + 1
Next tag
For spalte = spalte To 36
.Columns(spalte).Hidden = .Cells(1, spalte).Value = ""
Next
.Columns(spalte).NumberFormat = "DD DDD"
.Rows(1).NumberFormat = "DD DDD"
End With
Next Monat
Application.ScreenUpdating = True
End Sub