Code auf Worksheets erweitern
12.01.2018 13:13:45
Johann
hatt einer eine Idee warum dieser Code nicht auf Anderen Tabellen funktioniert?
Ich bräuchte diesen eigentlich auf Januar bis Dezember
Herzlichen Dank im voraus
Sub Kalender_erstellen()
Dim WsTabelle As Worksheet
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
Monat = 1
jahr = 2018
spalte = 1
With ActiveSheet
.Cells.Clear
For Each WsTabelle In Worksheets
For Monat = 1 To Monat
zeile = 1
ersterTag = CDate("01." & Monat & "." & jahr)
letzterTag = CDate("01." & Monat + 1 & "." & jahr) - 1
.Cells(zeile, spalte) = ersterTag
For tag = ersterTag To letzterTag
.Cells(zeile, spalte) = tag
If Weekday(tag) = 1 Or Weekday(tag) = 7 Then
.Cells(zeile, spalte).Interior.Color = vbRed
End If
spalte = spalte + 1
Next tag
.Columns(spalte).NumberFormat = "DD DDD"
Next Monat
.Rows(1).NumberFormat = "DD DDD"
Next WsTabelle
End With
End Sub