Option Explicit
Public Function Eastersunday(Jahr As Date) As Date
' Osterfunktion nach Carl Friedrich Gauß (1800).
' Rückgabewert ist der Datumswert des Ostersonntags im angegebenen Jahr.
' Gültigkeitsbereich: 1900 - 8702. Im Fehlerfall wird FALSE zurückgegeben
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
If (Jahr < 1583) Or (Jahr > 8702) Then
Eastersunday = False
Return
End If
' Die "magische" Gauss-Formel anwenden:
a = Jahr Mod 19
b = Jahr \ 100
c = (8 * b + 13) \ 25 - 2
d = b - (Jahr \ 400) - 2
e = (19 * (Jahr Mod 19) + ((15 - c + d) Mod 30)) Mod 30
If e = 28 Then
If a > 10 Then
e = 27
End If
ElseIf e = 29 Then
e = 28
End If
f = (d + 6 * e + 2 * (Jahr Mod 4) + 4 * (Jahr Mod 7) + 6) Mod 7
Eastersunday = DateSerial(Jahr, 3, e + f + 22)
End Function
Public Function Advent4(Jahr As Long) As Date
Dim WT As Long
WT = Weekday(DateSerial(Jahr, 12, 25))
If (WT = 1) Then
WT = 8
End If
Advent4 = DateSerial(Jahr, 12, 25 - WT + 1)
End Function
Public Function Ewigkeitssonntag(Jahr As Long) As Date
Dim WT As Long
WT = Weekday(DateSerial(Jahr, 12, 25))
If (WT = 1) Then
WT = 7
End If
Ewigkeitssonntag = DateSerial(Jahr, 12, 25 - 35 - WT + 1)
End Function