AW: zeige den Code von MonthName() ! o.T.
15.01.2018 20:08:48
MonthName()
Das ist der ganze Code.
Ziel ist es die nächsten leeren bis zu 4 Spalten nach dem end Datum des Monates auszublenden.
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 Integer
Dim spalte As Integer
jahr = 2018
Application.ScreenUpdating = False
For Monat = 1 To 12
spalte = 5
With Sheets(MonthName(Monat))
.Range("A2:AM99").ClearContents
.Range("A2:AM99").Interior.ColorIndex = xlNone
.Range("A2:AM99").EntireColumn.Hidden = False
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) = 1 Then
With .Columns(spalte)
.Interior.ColorIndex = 56
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
End If
If Weekday(tag) = 7 Then
With .Columns(spalte)
.Interior.ColorIndex = 48
.Font.Color = vbWhite
.ColumnWidth = 4.69
End With
End If
If Weekday(tag) = 2 Or Weekday(tag) = 3 Or Weekday(tag) = 4 Or Weekday(tag) = 5 Or _
Weekday(tag) = 6 Then
With .Columns(spalte)
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.ColumnWidth = 6.71
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
.Columns(spalte).NumberFormat = "DD DDD"
.Rows(1).NumberFormat = "DD DDD"
End With
Next Monat
Application.ScreenUpdating = True
End Sub