excel: kalender mit bedingten formatierungen (in vba)

vor langer zeit hab ich schonmal einmal einen kalender mit bedingten formatierungen in excel gebastelt. jetzt habe ich das mal mit vba gemacht… that’s it (eine von 100000 moeglichkeiten in quick & dirty):

Option Explicit

Sub Kalender()
   
    'Variablen deklarieren
    Dim MyStartDate As Date
    Dim MyEndDate As Date
    Dim MyTempDate As Date
    Dim OffsetX As Integer
    Dim OffsetY As Integer
    Dim BGWE As Integer
    Dim BGKW1 As Integer
    Dim BGKW2 As Integer
    Dim MyTempKW As Integer
    Dim Zähler As Integer
    Dim MyWorksheet As String
    Dim KWBackgrund As Integer
    Dim MyHeadLine As Variant
    Dim i As Integer

    'Start- und Endedatum setzen; möglich mit verschiedenen Schreibweisen
    MyStartDate = "01. Mai 2012"
    MyEndDate = "31.01.2014"
    'Tabellenblatt für den Kalender
    MyWorksheet = "Tabelle1"
    'in welcher Zeile soll der Kalender beginnen?
    OffsetY = 1
    'in welcher Spalte soll der Kalender beginnen?
    OffsetX = 1
    'Hintergrundfarbe für Wochenende
    BGWE = 15
    'Hintergrundfarbe für KW im Wechsel
    BGKW1 = 0
    BGKW2 = 16
    'Überschriften
    MyHeadLine = Array("Datum", "Tag", "KW")
    
    'Inhalt aller Zeilen löschen
    Rows("1:65536").ClearContents
    'Alle Formatierungen löschen
    Cells.ClearFormats

    'Überschriften
    For i = 0 To UBound(MyHeadLine)
        Worksheets(MyWorksheet).Cells(OffsetY, OffsetX + i).Value = MyHeadLine(i)
        Worksheets(MyWorksheet).Cells(OffsetY, OffsetX + i).Font.FontStyle = "Fett"
    Next
      
    
    'Kalender ausgeben
    For Zähler = 0 To DateDiff("d", MyStartDate, MyEndDate)
    
        MyTempDate = DateAdd("d", Zähler, MyStartDate)
        
        'Wochenende grau Markieren
        If Format(MyTempDate, "DDD") = "Sa" Or Format(MyTempDate, "DDD") = "So" Then
            Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 1).Interior.ColorIndex = BGWE
        End If
        
        'Farbwechsel für die KW
        KWBackgrund = IIf(kw_nach_din(MyTempDate) And 1, BGKW1, BGKW2)
        Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 2).Interior.ColorIndex = KWBackgrund

        'aktuellen Tag rot Markieren
        If MyTempDate = Date Then
            Worksheets(MyWorksheet).Range(Cells(1 + Zähler + OffsetY, OffsetX), Cells(1 + Zähler + OffsetY, OffsetX + 2)).Interior.Color = vbRed
        End If
        
        'erste Spalte mit Datum
        Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX).Value = MyTempDate
        
        'zweite Spalte mit Wochentag
        Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 1).Value = Format(MyTempDate, "DDD")
        
        'dritte Spalte mir KW (aber nur am ersten Tag der KW ausgeben)
        If MyTempKW <> kw_nach_din(MyTempDate) Then
            Worksheets(MyWorksheet).Cells(1 + Zähler + OffsetY, OffsetX + 2).Value = kw_nach_din(MyTempDate)
            MyTempKW = kw_nach_din(MyTempDate)
        End If
        
    Next Zähler
    
End Sub


Function kw_nach_din(datum As Date) As Byte
 Dim kw As Date
 kw = 4 + datum - Weekday(datum, 2)
 kw_nach_din = (kw - DateSerial(Year(kw), 1, -6)) \ 7
End Function

das ergebnis ist vergleichbar mit dem von damals: