Kalender forever

Teil 8: VBA: Geburts-/Festtagskalender

26.9.2008 von Redaktion pcmagazin

ca. 1:35 Min

Ratgeber

Ein Problem bei den Feiertagen ist, dass es sowohl fixe als auch bewegliche gibt. Die fixen Feiertage wie Weihnachten oder Neujahr fallen in jedem Jahr auf das gleiche Datum und bereiten den Kalenderproduzenten daher keine Probleme. Schwieriger wird es bei den beweglichen Feiertagen wie Karfreitag, Himmelfahrt oder Pfingsten, die sich allesamt am christlichen Osterfest orientieren. Und das fällt jedes Jahr auf ein anderes Datum, genauer: auf den Sonntag nach dem ersten Vollmond im Anschluss an die März-Tagundnachtgleiche - so will es der bis heute gültige Beschluss eines Konzils, das im Jahre 325 in Nicäa (dem heutigen Iznik in der Türkei) abgehalten wurde. Der Mathematiker und Astronom Carl Friedrich Gauß (1777-1855) hat diese kaum nachvollziehbare Festlegung in einen konkreten Algorithmus überführt, der in der benutzerdefinierten Funktion Osterdatum (siehe unten) eine BASIC-gemäße Umsetzung findet. Die Einzelheiten dieser Rechenvorschrift dürften normal veranlagte Menschen - der Autor schließt sich da ein - kaum verstehen. Wichtig ist nur: Die Funktion berechnet das Osterdatum eines im int- Jahr-Argument angegebenen Jahres, das zwischen 1900 und 2078 liegen muss. Bei allen Jahreszahlen unteroder oberhalb dieser Zeitspanne liefert der Algorithmus unter Umständen ein falsches Ergebnis.

Feiertagsberechnung Rechnen lassen: Das kleine Listing berechnet die Feiertage für Ihren Kalender. 1: Function OsterDatum(intJahr _ 2: As Integer) As Date 3: Dim intA As Integer 4: Dim intB As Integer 5: Dim intC As Integer 6: Dim intD As Integer 7: Dim intE As Integer 8: Dim intTag As Integer 9: Dim intMonat As Integer 10: intA = intJahr Mod 19 11: intB = intJahr Mod 4 12: intC = intJahr Mod 7 13: intD = (19 * intA + 24) Mod 30 14: intE = (2 * intB + 4 * intC + _ 15: 6 * intD + 5) Mod 7 16: intTag = 22 + intD + intE 17: intMonat = 3 18: If intTag > 31 Then 19: intTag = intD + intE - 9 20: intMonat = 4 21: End If 22: If intTag = 26 And intMonat _ 23: = 4 Then 24: intTag = 19 25: End If 26: If intTag = 25 And intMonat = _ 27: 4 And intD = 28 And intE = 6 _ 28: And intA > 10 Then 29: intTag = 18 30: End If 31: OsterDatum = DateSerial(Year: _ 32: =intJahr, Month:=intMonat, _ 33: Day:=intTag) 34: End Function