VB 5/6-Tipp 0344: Berechnung von Feiertagen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2" (Index von 0 bis 1)
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1" (Index von 0 bis 4)
' Steuerelement: Beschriftungsfeld "Label2" (Index von 0 bis 4)


'Autor: Lothar Kriegerow
'E-Mail: lausitz@t-online.de

Option Explicit

Private Sub Command1_Click()
    Dim GDatum As Date
    Dim a As Long, b As Long, c As Long
    Dim d As Long, e As Long, f As Long
    Dim g As Long, h As Long, i As Long
    Dim k As Long, l As Long, m As Long
    Dim Wert As Long, Monat As Long
    Dim Datum As Long, Jahr As Long
    
    Jahr = Val(Text1)
    If Jahr < 1580 Then Exit Sub
    Jahr = Text1
    
    'Osterformel nach Gauß
    a = Jahr Mod 19
    b = Jahr \ 100
    c = Jahr Mod 100
    d = b \ 4
    e = b Mod 4
    f = (b + 8) \ 25
    g = (b - f + 1) \ 3
    h = (19 * a + b - d - g + 15) Mod 30
    i = c \ 4
    k = c Mod 4
    l = (32 + 2 * e + 2 * i - h - k) Mod 7
    m = (a + 11 * h + 22 * l) \ 451
    Wert = h + l - 7 * m + 22
    Monat = 3 - (Wert > 31)
    Datum = Wert + 31 * (Wert > 31)
    GDatum = DateSerial(Jahr, Monat, Datum)
    
    Label1(0) = DateAdd("d", GDatum, -47)
    Label1(1) = GDatum
    Label1(2) = DateAdd("d", GDatum, 39)
    Label1(3) = DateAdd("d", GDatum, 49)
    Label1(4) = DateAdd("d", GDatum, 60)
End Sub

Private Sub Command2_Click(i As Integer)
    Select Case i
        Case 0
            If Text1 > 1560 Then Text1 = Text1 - 1
            
        Case 1
            Text1 = Text1 + 1
    End Select
End Sub


'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Function OSTERN(JAHR As Long) As Date
    a& = JAHR Mod 19
    b& = JAHR \ 100
    c& = JAHR Mod 100
    d& = b \ 4
    e& = b Mod 4
    f& = (b + 8) \ 25
    g& = (b - f + 1) \ 3
    h& = (19 * a + b - d - g + 15) Mod 30
    i& = c \ 4
    k& = c Mod 4
    l& = (32 + 2 * e + 2 * i - h - k) Mod 7
    m& = (a + 11 * h + 22 * l) \ 451
    wert& = h + l - 7 * m + 22
    monat& = 3 - (wert > 31)
    datum& = wert + 31 * (wert > 31)
    OSTERN = DateSerial(JAHR, monat, datum)
End Function