Function f_feiertag(dat As Date) As Boolean 'Autor: Heiko Hommes 'Datum: 02.05.2007 'Beschr: Hier wird gepüft, ob das übergebene Datum ein Feiertag ist 'Übergabe ist das Jahr 'Rückgabe Feiertag true oder false Dim A%, B%, C%, D%, E%, M%, N%, P%, j% Dim ostern As Date ' Exit Function f_feiertag = False j = Year(dat) A = j Mod 19 B = j Mod 4 C = j Mod 7 M = 24 N = 5 D = (19 * A + M) Mod 30 E = (2 * B + 4 * C + 6 * D + N) Mod 7 P = 22 + D + E 'Neujahr If dat = CDate("01.01." & j) Then f_feiertag = True 'Tag der Arbeit If dat = CDate("01.05." & j) Then f_feiertag = True 'Nationalfeiertag If dat = CDate("03.10." & j) Then f_feiertag = True 'Allerheiligen If dat = CDate("01.11." & j) Then f_feiertag = True 'Heiligabend If dat = CDate("24.12." & j) Then f_feiertag = True '1.Weihnachtstag If dat = CDate("25.12." & j) Then f_feiertag = True '2.Weihnachtstag If dat = CDate("26.12." & j) Then f_feiertag = True 'Sylvester If dat = CDate("31.12." & j) Then f_feiertag = True If f_feiertag Then Exit Function If P > 31 Then If P = 56 And D = 28 And A > 10 Then ostern = DateSerial(j, 4, 18) ElseIf P = 57 Then ostern = DateSerial(j, 4, 19) Else ostern = DateSerial(j, 4, P - 31) End If Else ostern = DateSerial(j, 3, P) End If 'Osternsonntag If dat = DateAdd("d", 0, ostern) Then f_feiertag = True 'Osternmontag If dat = DateAdd("d", 1, ostern) Then f_feiertag = True 'Karfreitag If dat = DateAdd("d", -2, ostern) Then f_feiertag = True 'Christi Himmelsfahrt If dat = DateAdd("d", 39, ostern) Then f_feiertag = True 'Pfingstsonntag If dat = DateAdd("d", 49, ostern) Then f_feiertag = True 'Pfingstmontag If dat = DateAdd("d", 50, ostern) Then f_feiertag = True 'Fronleichnam If dat = DateAdd("d", 60, ostern) Then f_feiertag = True End Function