[sivro]

Versuchs mal damit

Sub Jahreskalender()
Dim ws As Worksheet
Dim varYear As Variant
Dim bytMonth As Byte
Dim bytDay As Byte
Dim bytWeekday As Byte
Dim strWeekday As String
Dim bytWeekNo As Byte
Dim bytDummy As Byte
' Das Jahr des Kalenders, der ausgegeben werden soll
varYear = Range("B2")
' Falls bereits ein Blatt mit dem Namen "Jahr xxxx"
' existiert, soll dieses gelöscht werden
For Each ws In Worksheets
If ws.Name = "Jahr " & varYear Then
ws.Delete
End If
Next ws
' Ein neues Tabellenblatt mit dem Namen "Jahr xxxx"' einfügen
Worksheets.Add
ActiveSheet.Name = "Jahr " & varYear
' Monatsüberschriften einfügen und formatieren
For bytMonth = 1 To 12
With Cells(1, bytMonth)
.Value = Format(DateSerial(varYear, bytMonth, 1), _
"mmmm")
.Interior.ColorIndex = 36
.Font.Bold = True
End With
' Tage aufbereiten
For bytDay = 1 To Day(DateSerial _
(varYear, bytMonth + 1, 0))
With Cells(bytDay + 1, bytMonth)
bytWeekday = Weekday(DateSerial _
(varYear, bytMonth, bytDay))
' Wochentage in Textformat aufbereiten
Select Case bytWeekday
Case 1
strWeekday = "So"
Case 2
strWeekday = "Mo"
Case 3
strWeekday = "Di"
Case 4
strWeekday = "Mi"
Case 5
strWeekday = "Do"
Case 6
strWeekday = "Fr"
Case 7
strWeekday = "Sa"
End Select
' Wochentage und Tage eintragen
.Value = strWeekday & ", " & bytDay
' Samstage hellgrau hervorheben
If bytWeekday = 7 Then
.Interior.ColorIndex = 15
End If
' Sonntage dunkelgrau hervorheben
If bytWeekday = 1 Then
.Interior.ColorIndex = 48
End If
' Kalenderwoche eintragen
bytWeekNo = _
Format(DateSerial(varYear, bytMonth, bytDay), _
"ww")
If bytDummy < bytWeekNo And strWeekday <> "So" Then
bytDummy = bytWeekNo
.Value = .Value & " (" & bytDummy & ")"
' Formatierung Kalenderwoche
With .Characters _
(Start:=InStr(1, .Value, "("), _
Length:=4).Font
.Size = 8
.Color = vbRed
End With
End If
End With
Next bytDay
Next bytMonth
End Sub

Einfach in ein Modul einfügen und mit F5 ausführen. Vielleicht lässt sich der Code ja deinen Wünschen anpassen.


Quelle:
Microsoft Office Excel 2007-Programmierung
Das Handbuch