Kontakt
DSVGO
Historie | |
11.06.2001 | Erste Version (nach einer Idee von Michael Reinold, GGRZ Hagen) |
Die unten definierten Funktionen bestimmen, ob an einem bestimmten Datum Feiertag ist. Da die beweglichen Feiertage (Ostern, Pfingsten, ...) von Jahr zu Jahr auf unterschiedliche Termine fallen, sind ein paar Klimmzüge notwendig.
Die Routinen geben einen Leerstring zurück, falls das Datum gar kein Feiertag ist. Wird ein Feiertag mit angehängtem "*" zurückgegeben, so handelt es sich bei dem Feiertag nicht um einen bundeseinheitlichen gesetzlichen Feiertag. Wird kein Datum angegeben, so wird das aktuelle Datum (Now) angenommen.
Der unten stehende Code benutzt die Feiertag-Funktion, um festzustellen, ob an einem bestimmten Datum ein Feiertag ist:
Function IstFeiertag( _ Optional ByVal Datum As Variant _ ) As Boolean IstFeiertag = Len(Feiertag(Datum)) > 0 End Function
Mit der gerade definierten Funktion können nun einfach alle Feiertage des aktuellen Jahres ausgegeben werden. Dazu muss nur folgender Code in die Click-Prozedur eines Formulars eingegeben werden:
Private Sub Form_Click() Dim Jahr As Integer Dim Datum As Variant Cls Jahr = Year(Now) Print "Feiertage im Jahr"; Jahr For Datum = DateSerial(Jahr, 1, 1) To DateSerial(Jahr, 12, 31) If IstFeiertag(Datum) Then Print Datum, Feiertag(Datum) Next Datum End Sub
Wird nun das Programm gestartet und auf das Formular geklickt, so erscheint die Liste aller Feiertage.
Die folgende Funktion bestimmt für ein gegebenes Datum den Namen des Feiertags. Dabei werden auch die beweglichen Feiertage berücksichtigt.
Public Function Feiertag( _ Optional ByVal Datum As Variant _ ) As String Dim TagMonat As Integer If IsMissing(Datum) Then Datum = Now TagMonat = Day(Datum) * 100 + Month(Datum) Select Case TagMonat 'im Format DDMM Case 101: Feiertag = "Neujahr" Case 601: Feiertag = "Dreikönigstag *" Case 105: Feiertag = "Tag der Arbeit" Case 1508: Feiertag = "Mariä Himmelfahrt *" Case 310: Feiertag = "Tag der deutschen Einheit" Case 111: Feiertag = "Allerheiligen" Case 2412: Feiertag = "Heiligabend *" Case 2512: Feiertag = "1. Weihnachtstag" Case 2612: Feiertag = "2. Weihnachtstag" Case 3112: Feiertag = "Silvester *" Case Else: Feiertag = FeiertagV(Datum) End Select End Function
Man beachte, wie aus Performance-Gründen das Tupel aus Tag und Monat in eine "sprechende" Ganzzahl konvertiert wird.
Die sogenannten beweglichen Feiertage hängen alle davon ab, an welchem Tag der Ostersonntag fällt. Sie werden relativ dazu durch feste Abstände definiert:
Public Function FeiertagV( _ Optional ByVal Datum As Variant _ ) As String Dim Tage As Integer If IsMissing(Datum) Then Datum = Now Tage = DateDiff("d", Ostersonntag(Year(Datum)), Datum) Select Case Tage 'relativ zu Ostersonntag Case -2: FeiertagV = "Karfreitag" Case 0: FeiertagV = "Ostersonntag" Case 1: FeiertagV = "Ostermontag" Case 39: FeiertagV = "Christi Himmelfahrt" Case 49: FeiertagV = "Pfingsonntag" Case 50: FeiertagV = "Pfingstmontag" Case 60: FeiertagV = "Fronleichnam" End Select End Function
Der Ostersonntag-Termin hängt vom Erscheinen des Vollmonds ab. Die Bestimmung des Datums ist also ein komplexes astronomisches Problem. Zum Glück hat C.F.Gauss eine relativ einfache Näherungsformel publiziert, welche (nach leichter Modifikation) dieses Problem für die Jahre 1583 bis 8202 löst:
Public Function Ostersonntag( _ Optional ByVal Jahr As Integer _ ) As Variant Dim d1 As Integer Dim d2 As Integer Dim d3 As Integer Dim d4 As Integer 'Formel nach C.F.Gauss gilt 1583 - 8202: If Jahr = 0 Then Jahr = Year(Now) If Jahr < 1583 Or Jahr > 8202 Then _ Err.Raise 5 'Invalid argument' 'Berechnung der Korrekturwerte: d1 = (8 * (Jahr \ 100) + 13) \ 25 - 2 d2 = (Jahr \ 100) - (Jahr \ 400) - 2 d1 = (15 + d2 - d1) Mod 30 d3 = 2 * (Jahr Mod 4) + 4 * (Jahr Mod 7) d4 = (d1 + 19 * (Jahr Mod 19)) Mod 30 If d4 = 29 Then d4 = 28 ElseIf d4 = 28 Then If (Jahr Mod 19) > 10 Then d4 = 27 End If d3 = (6 + d2 + d3 + 6 * d4) Mod 7 'Berechnung des Datums (ausgehend vom 22.3.): Ostersonntag = DateSerial(Jahr, 3, 22 + d4 + d3) End Function
© Jost Schwider, 11.06.2001-11.06.2001 - http://vb-tec.de/feiertag.htm