AW: Feiertage in einer MsgBox
09.09.2003 11:16:01
M@rkus
Hallo Werner!
Hier ist einmal die Osterformel und unten drunter wird in einer Message Box ausgegeben ob am aktuellen Datum ein Feiertag vorliegt. Allerdings sind das nur die Hessichen Feiertage, aber das kannst Du ganz einfach anpassen. Die Feiertage werden immer von er Osterformel ausberechnet
Public
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
Sub 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 sAschermittwoch 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)
sAschermittwoch = DateSerial(Year(sOstern), Month(sOstern), Day(sOstern) - 46)
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 sAschermittwoch
sEintrag = "Aschermittwoch"
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 = "Tag der dt. Einheit"
Case sHeiligabend
sEintrag = "Heiligabend"
Case sWeihnachstag1
sEintrag = "1. Weihnachtstag"
Case sWeihnachtstag2
sEintrag = "2. Weihnachtstag"
Case sSylvester
sEintrag = "Silvester"
Case Else
sEintrag = ""
End Select
If sEintrag <> "" Then
MsgBox "Heute ist " + sEintrag + " !", vbInformation
End If
End Sub
Gruss Markus
