zum Ausdrucken oder als Onlineausgabe:
http://www.schoenherr.de/download/kalender.php
http://www.kalenderland.com/
OpenOffice-Vorlage (leider nur in Englisch)
http://www.chip.de/downloads/c1_downloads_auswahl_53017375.html?t=1324620393&v=3600&s=13be835bc7ff65af5850104c1926870a
http://bighugelabs.com/calendar.php
Grüße
Erwin
Anwendungs-Software und Apps 14.435 Themen, 72.967 Beiträge
Option Explicit
Sub KalenderEinfügen() 'Jahreskalenderblatt
Dim Z, S, Year, Month, Day
Dim Eingabe As String
Dim erg%
Eingabe = InputBox("Bitte gib die Jahreszahl ein:", "Jahreskalender")
If IsNumeric(Eingabe) And Eingabe > "2000" And Eingabe Year = Eingabe
Else
erg = MsgBox("Jahreszahl ist ungültig.", vbCritical, "Nur Zahlen eingeben")
End
End If
Cells(1, 1) = Year
Z = 1
S = 1
'Formatierungen und Ausgangswerte
Range(Cells(Z, S + 1), Cells(Z, S + 12)).NumberFormat = "MMM"
Range(Cells(Z, S + 1), Cells(Z, S + 12)).HorizontalAlignment = xlCenter
Range(Cells(Z + 1, S), Cells(Z + 31, S)).NumberFormat = "0""."""
Range(Cells(Z + 1, S), Cells(Z + 31, S + 12)).HorizontalAlignment = xlLeft
Range(Cells(Z + 1, S + 1), Cells(Z + 31, S + 12)).NumberFormat = "DDD"
Range(Cells(Z, S), Cells(Z + 31, S + 12)).Borders.ColorIndex = 1
Range(Cells(Z, S), Cells(Z + 31, S + 12)).Interior.ColorIndex = 0
Range(Cells(Z + 1, S), Cells(Z + 31, S + 12)).Formula = ""
'Felder ausfüllen
For Month = 1 To 12
Cells(Z, S + Month) = CDate(1 & "." & Month & "." & Year)
For Day = 1 To 31
Cells(Z + Day, S) = Day
If IsDate(Day & "." & Month & "." & Year) Then
Cells(Z + Day, S + Month) = CDate(Day & "." & Month & "." & Year)
If Weekday(Cells(Z + Day, S + Month)) = 1 Then
Cells(Z + Day, S + Month).Interior.ColorIndex = 48
ElseIf Weekday(Cells(Z + Day, S + Month)) = 7 Then
Cells(Z + Day, S + Month).Interior.ColorIndex = 15
End If
End If
Next
Next
End Sub