AW: Funktion Jahreszeiten-Feiertage
08.12.2008 13:19:37
Rudi
Hallo,
Function ListeFeiertage(dteStart As Date, dteEnde As Date) As String
Dim i As Date, strTemp As String
For i = dteStart To dteEnde
strTemp = strFeiertag(i)
If strTemp "" Then Feiertage = Feiertage & strTemp & "; "
Next
Feiertage = Left(Feiertage, Len(Feiertage) - 2)
End Function
Function strFeiertag(dteDatum As Date) As String
Dim d As Integer, iJahr As Integer, dteOsterSonntag As Date
iJahr = Year(dteDatum)
d = (((255 - 11 * (iJahr Mod 19)) - 21) Mod 30) + 21
dteOsterSonntag = _
DateSerial(iJahr, 3, 1) + d + (d > 48) + 6 - ((iJahr + iJahr \ 4 + d + (d > 48) + 1) Mod 7)
Select Case dteDatum
Case dteOsterSonntag - 2: strFeiertag = "Karfreitag"
Case dteOsterSonntag: strFeiertag = "Ostersonntag"
Case dteOsterSonntag + 1: strFeiertag = "Ostermontag"
Case dteOsterSonntag + 39: strFeiertag = "Christi Himmelfahrt"
Case dteOsterSonntag + 49: strFeiertag = "Pfingstsonntag"
Case dteOsterSonntag + 50: strFeiertag = "Pfingstmontag"
Case dteOsterSonntag + 60: strFeiertag = "Fronleichnam"
Case DateSerial(iJahr, 1, 1): strFeiertag = "Neujahr"
Case DateSerial(iJahr, 5, 1): strFeiertag = "Maifeiertag"
Case DateSerial(iJahr, 10, 3): strFeiertag = "Tag der Einheit"
Case DateSerial(iJahr, 11, 1): strFeiertag = "Allerheiligen"
Case DateSerial(iJahr, 12, 25): strFeiertag = "1.Weihnachtstag"
Case DateSerial(iJahr, 12, 26): strFeiertag = "2.Weihnachtstag"
End Select
End Function
Gruß
Rudi