Anwendungs-Software und Apps 14.489 Themen, 73.614 Beiträge

Kostenlose Kalender

schoppes / 2 Antworten / Baumansicht Nickles
"Früher war alles besser. Sogar die Zukunft." (Karl Valentin)
bei Antwort benachrichtigen
groggyman schoppes „Kostenlose Kalender“
Optionen

Hallo
Du bist einfach zu gut für diese Welt, hast ja wieder ein paar schöne Links ausgegraben, D A N K E !

Gruß

-groggyman-

bei Antwort benachrichtigen
gelöscht_265507 schoppes „Kostenlose Kalender“
Optionen

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

bei Antwort benachrichtigen