AW: Feiertag bestimmen (VBA-Fkt.)
15.08.2003 09:36:45
Sigi E.
Hallo Frederik,
mit folgenden drei VBA-Funktionen geht's auch ...
Function IstFeiertag(Datum As Date) As Boolean
If FeiertagName(Datum) <> "" Then
IstFeiertag = True
Else
IstFeiertag = False
End If
End Function
Function FeiertagName(Datum As Date) As String
Dim Txt As String
If Datum = Osterdatum(Year(Datum)) - 2 Then
Txt = "Karfreitag"
ElseIf Datum = Osterdatum(Year(Datum)) Then
Txt = "Ostersonntag"
ElseIf Datum = Osterdatum(Year(Datum)) + 1 Then
Txt = "Ostermontag"
ElseIf Datum = Osterdatum(Year(Datum)) + 39 Then
Txt = "Christi Himmelfahrt"
ElseIf Datum = Osterdatum(Year(Datum)) + 49 Then
Txt = "Pfingstsonntag"
ElseIf Datum = Osterdatum(Year(Datum)) + 50 Then
Txt = "Pfingstmontag"
ElseIf Datum = Osterdatum(Year(Datum)) + 60 Then
Txt = "Fronleichnam"
ElseIf Datum = DateSerial(Year(Datum), 1, 1) Then
Txt = "Neujahr"
ElseIf Datum = DateSerial(Year(Datum), 1, 6) Then
Txt = "Hl. drei Könige"
ElseIf Datum = DateSerial(Year(Datum), 5, 1) Then
Txt = "Maifeiertag"
ElseIf Datum = DateSerial(Year(Datum), 8, 15) Then
Txt = "Mariä Himmelfahrt"
ElseIf Datum = DateSerial(Year(Datum), 10, 3) Then
Txt = "Tag d. dt. Einheit"
ElseIf Datum = DateSerial(Year(Datum), 10, 31) Then
Txt = "Reformationstag"
ElseIf Datum = DateSerial(Year(Datum), 11, 1) Then
Txt = "Allerheiligen"
ElseIf Datum = DateSerial(Year(Datum), 12, 25) Then
Txt = "Weihnachten1"
ElseIf Datum = DateSerial(Year(Datum), 12, 26) Then
Txt = "Weihnachten2"
ElseIf Datum = DateSerial(Year(Datum), 12, 25) - _
Weekday(DateSerial(Year(Datum), 12, 25), _
vbMonday) - 32 Then
Txt = "Buß- u. Bettag"
Else
Txt = ""
End If
FeiertagName = Txt
End Function
Function Osterdatum(Jahr As Long)
Dim D As Long
D = (((255 - 11 * (Jahr Mod 19)) - 21) Mod 30) + 21
Osterdatum = DateSerial(Jahr, 3, 1) + D + (D > 48) + _
6 - ((Jahr + Jahr \ 4 + D + (D > 48) + 1) Mod 7)
End Function
Feiertage, die es in deiner Region nicht gibt, musst du noch aus dem Code löschen!
Gruß
Sigi