Start von Makro und Funktion
01.10.2003 08:59:18
Werner Busch
ich möchte, dass mein Jahreskalender mit 12 Monatsblättern im aktuellen Monat startet. Außerdem sollen die Feiertage (Tag in Spalte A, Wochentag in Spalte B)berechnet und farbig unterlegt werden. Bei den Feiertagen soll eine Meldung erfolgen, um welchen Feiertag es sich handelt. Dies wollte ich mit folgendem Makro realsieren, leider läuft es nicht. Woran hängt es? Danke im Voraus!
Private Sub Workbook_Open()
Worksheets(Month(Date)).Activate
End Sub
Function Ostern(Yr As Integer)
Dim D As Integer
D = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
Ostern = DateSerial(Yr, 3, 1) + D + (D > 48) + 6 - ((Yr + Yr \ 4 + D + (D > 48) + 1) Mod 7)
End Function
Function Feiertagsberechnung()
Dim sOstern As Date
Dim sNeujahr As Date
Dim sOstermontag As Date
Dim sKarfreitag As Date
Dim sFastnacht As Date
Dim sRosenmontag As Date
Dim sMaifeiertag As Date
Dim sPfingstsonntag As Date
Dim sPfingstmontag As Date
Dim sFronleichnam As Date
Dim sChristiHimmelfahrt As Date
Dim sTagderDeutschenEinheit As Date
Dim sHeiligabend As Date
Dim sWeihnachstag1 As Date
Dim sWeihnachtstag2 As Date
Dim sSylvester As Date
Dim sEintrag As String
sOstern = Ostern(Year(Date))
sOstermontag = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) + 1)
sNeujahr = "01.01." & Year(Date)
sKarfreitag = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) - 2)
sFastnacht = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) - 47)
sRosenmontag = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) - 48)
sMaifeiertag = "01.05." & Year(Date)
sPfingstsonntag = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) + 49)
sPfingstmontag = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) + 50)
sFronleichnam = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) + 60)
sChristiHimmelfahrt = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) + 39)
sTagderDeutschenEinheit = "03.10." & Year(Date)
sHeiligabend = "24.12." & Year(Date)
sWeihnachtstag2 = "26.12." & Year(Date)
sWeihnachstag1 = "25.12." & Year(Date)
sSylvester = "31.12." & Year(Date)
Select Case Str(Date)
Case sNeujahr
sEintrag = "Neujahr"
Case sOstern
sEintrag = "Ostersonntag"
Case sOstermontag
sEintrag = "Ostermontag"
Case sKarfreitag
sEintrag = "Karfreitag"
Case sFastnacht
sEintrag = "Fastnacht"
Case sRosenmontag
sEintrag = "Rosenmontag"
Case sMaifeiertag
sEintrag = "Maifeiertag"
Case sChristiHimmelfahrt
sEintrag = "Christi Himmelfahrt"
Case sPfingstsonntag
sEintrag = "Pfingstsonntag"
Case sPfingstmontag
sEintrag = "Pfingstmontag"
Case sFronleichnam
sEintrag = "Fronleichnam"
Case sTagderDeutschenEinheit
sEintrag = "der Tag der dt. Einheit"
Case sHeiligabend
sEintrag = "Heiligabend"
Case sWeihnachstag1
sEintrag = "der 1. Weihnachtstag"
Case sWeihnachtstag2
sEintrag = "der 2. Weihnachtstag"
Case sSylvester
sEintrag = "Silvester"
Case Else
sEintrag = ""
End Select
If sEintrag <> "" Then
MsgBox "Heute ist " + sEintrag + ". Bitte Eintragungen prüfen!", vbInformation
End If
End Function