65 Feiertage berechnen Berechnet 65 Feiertage (Christliche, Gedenktage, ...)
Autor:   Steffen Stamprath	Bewertung:     [ Jetzt bewerten ]	Views:  48.732
www.bluedeveloper.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 116 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.7 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit nachfolgendem Code lassen sich insgesamt 65 Feiertage berechnen.

Erstellen Sie ein neues Projekt, platzieren auf die Form eine ListBox und einen CommandButton, und fügen nachfolgenden Code in den Codeteil der Form ein.

Option Explicit
 
Private Type TypeFeiertag
  NameA As String
  DatumA As Date
End Type

' alle Feiertage berechnen
Private Sub GetAlleFeiertag(JahrA As Long, FeiertagA() As TypeFeiertag)
  Dim a, b, c, d, e, f, s As Long
  Dim M, N As Long
  Dim OsternA As Date
  ReDim FeiertagA(64)
 
  FeiertagA(0).NameA = "4. Advent"
  FeiertagA(0).DatumA = GetViertenAdvent(JahrA)
 
  FeiertagA(1).NameA = "3. Advent"
  FeiertagA(1).DatumA = DateAdd("d", -7, GetViertenAdvent(JahrA))
 
  FeiertagA(2).NameA = "2. Advent"
  FeiertagA(2).DatumA = DateAdd("d", -14, GetViertenAdvent(JahrA))
 
  FeiertagA(3).NameA = "1. Advent"
  FeiertagA(3).DatumA = DateAdd("d", -21, GetViertenAdvent(JahrA))
 
  FeiertagA(4).NameA = "Totensonntag"
  FeiertagA(4).DatumA = DateAdd("d", -28, GetViertenAdvent(JahrA))
 
  FeiertagA(5).NameA = "Volkstrauertag"
  FeiertagA(5).DatumA = DateAdd("d", -35, GetViertenAdvent(JahrA))
 
  FeiertagA(6).NameA = "Buß- und Bettag"
  FeiertagA(6).DatumA = DateAdd("d", -11, FeiertagA(3).DatumA)
 
  FeiertagA(7).NameA = "Muttertag"
  FeiertagA(7).DatumA = GetMuttertag(JahrA)
 
  FeiertagA(8).NameA = "Erntedankfest"
  FeiertagA(8).DatumA = GetErntedankfest(JahrA)
 
  FeiertagA(9).NameA = "Neujahr"
  FeiertagA(9).DatumA = "01.01." & JahrA
 
  FeiertagA(10).NameA = "Heiligen drei Könige"
  FeiertagA(10).DatumA = "06.01." & JahrA
 
  FeiertagA(11).NameA = "Maifeiertag"
  FeiertagA(11).DatumA = "01.05." & JahrA
 
  FeiertagA(12).NameA = "Tag der Deutschen Einheit"
  FeiertagA(12).DatumA = "03.10." & JahrA
 
  FeiertagA(13).NameA = "Heiligabend"
  FeiertagA(13).DatumA = "24.12." & JahrA
 
  FeiertagA(14).NameA = "1. Weihnachtstag"
  FeiertagA(14).DatumA = "25.12." & JahrA
 
  FeiertagA(15).NameA = "2. Weihnachtstag"
  FeiertagA(15).DatumA = "26.12." & JahrA
 
  FeiertagA(16).NameA = "Silvester"
  FeiertagA(16).DatumA = "31.12." & JahrA
 
  FeiertagA(17).NameA = "Reformationstag"
  FeiertagA(17).DatumA = "31.10." & JahrA
 
  FeiertagA(18).NameA = "Allerheiligen"
  FeiertagA(18).DatumA = "01.11." & JahrA
 
  FeiertagA(19).NameA = "Maria Himmelfahrt"
  FeiertagA(19).DatumA = "15.08." & JahrA
 
  FeiertagA(20).NameA = "Valentinstag"
  FeiertagA(20).DatumA = "14.02." & JahrA
 
  FeiertagA(21).NameA = "Tag der Arbeit"
  FeiertagA(21).DatumA = "01.05." & JahrA
 
  FeiertagA(22).NameA = "Friedensfest"
  FeiertagA(22).DatumA = "08.08." & JahrA
 
  FeiertagA(23).NameA = "Nikolaus"
  FeiertagA(23).DatumA = "06.12." & JahrA
 
  a = JahrA Mod 19
  b = JahrA Mod 4
  c = JahrA Mod 7
  M = Val(((8 * Val(JahrA / 100) + 13) / 25) - 2)
  s = Val(JahrA / 100) - Val(JahrA / 400) - 2
  M = (15 + s - M) Mod 30
  N = (6 + s) Mod 7
  d = (M + 19 * a) Mod 30
  If d = 29 Then
  d = 28
  ElseIf d = 28 Then
      If (JahrA Mod 19) > 10 Then d = 27
  End If
  e = (2 * b + 4 * c + 6 * d + N) Mod 7
  OsternA = Format$(DateAdd("d", (d + e + 1), "21.03." & JahrA), "dd.mm.yyyy")
 
  FeiertagA(24).NameA = "Ostersonntag"
  FeiertagA(24).DatumA = OsternA
 
  FeiertagA(25).NameA = "Ostermontag"
  FeiertagA(25).DatumA = DateAdd("d", 1, OsternA)
 
  FeiertagA(26).NameA = "Karfreitag"
  FeiertagA(26).DatumA = DateAdd("d", -2, OsternA)
 
  FeiertagA(27).NameA = "Pfingstsonntag"
  FeiertagA(27).DatumA = DateAdd("d", 49, OsternA)
 
  FeiertagA(28).NameA = "Pfingstmontag"
  FeiertagA(28).DatumA = DateAdd("d", 50, OsternA)
 
  FeiertagA(29).NameA = "Christi Himmelfahrt"
  FeiertagA(29).DatumA = DateAdd("d", 39, OsternA)
 
  FeiertagA(30).NameA = "Aschermittwoch"
  FeiertagA(30).DatumA = DateAdd("d", -46, OsternA)
 
  FeiertagA(31).NameA = "Fronleichnam"
  FeiertagA(31).DatumA = DateAdd("d", 60, OsternA)
 
  FeiertagA(32).NameA = "Herz-Jesu-Freitag"
  FeiertagA(32).DatumA = DateAdd("d", 68, OsternA)
 
  FeiertagA(33).NameA = "Rosenmontag"
  FeiertagA(33).DatumA = DateAdd("d", -48, OsternA)
 
  FeiertagA(34).NameA = "Eisheiligen: Mamertus"
  FeiertagA(34).DatumA = "11.05." & JahrA
 
  FeiertagA(35).NameA = "Eisheiligen: Pankratius"
  FeiertagA(35).DatumA = "12.05." & JahrA
 
  FeiertagA(36).NameA = "Eisheiligen: Servatius"
  FeiertagA(36).DatumA = "13.05." & JahrA
 
  FeiertagA(37).NameA = "Eisheiligen: Bonifatius"
  FeiertagA(37).DatumA = "14.05." & JahrA
 
  FeiertagA(38).NameA = "Eisheiligen: kalte Sophie"
  FeiertagA(38).DatumA = "15.05." & JahrA
 
  FeiertagA(39).NameA = "Weiber Fastnacht"
  FeiertagA(39).DatumA = DateAdd("d", -52, OsternA)
 
  FeiertagA(40).NameA = "Fastnacht"
  FeiertagA(40).DatumA = DateAdd("d", -47, OsternA)
 
  FeiertagA(41).NameA = "Beginn der Sommerzeit"
  FeiertagA(41).DatumA = GetBeginnSommerzeit(JahrA)
 
  FeiertagA(42).NameA = "Beginn der Winterzeit"
  FeiertagA(42).DatumA = GetBeginnWinterzeit(JahrA)
 
  FeiertagA(43).NameA = "Winteranfang"
  FeiertagA(43).DatumA = "21.12." & JahrA
 
  FeiertagA(44).NameA = "Frühlingsanfang"
  FeiertagA(44).DatumA = "20.03." & JahrA
 
  FeiertagA(45).NameA = "Sommeranfang"
  FeiertagA(45).DatumA = "21.06." & JahrA
 
  FeiertagA(46).NameA = "Herbstanfang"
  FeiertagA(46).DatumA = "22.09." & JahrA
 
  FeiertagA(47).NameA = "Tag des Gedenkens an die Opfer des Nationalsozialismus"
  FeiertagA(47).DatumA = "27.01." & JahrA
 
  FeiertagA(48).NameA = "Unbefleckte Empfängnis Mariens"
  FeiertagA(48).DatumA = "08.12." & JahrA
 
  FeiertagA(49).NameA = "Darstellung des Herrn"
  FeiertagA(49).DatumA = "02.02." & JahrA
 
  FeiertagA(50).NameA = "Joseftag"
  FeiertagA(50).DatumA = "19.03." & JahrA
 
  FeiertagA(51).NameA = "Verkündigung des Herrn"
  FeiertagA(51).DatumA = "25.03." & JahrA
 
  FeiertagA(52).NameA = "Geburt Johannes des Täufers"
  FeiertagA(52).DatumA = "24.06." & JahrA
 
  FeiertagA(53).NameA = "Fest der Apostel Petrus und Paulus"
  FeiertagA(53).DatumA = "29.06." & JahrA
 
  FeiertagA(54).NameA = "Mariä Heimsuchung"
  FeiertagA(54).DatumA = "02.07." & JahrA
 
  FeiertagA(55).NameA = "Verklärung des Herrn"
  FeiertagA(55).DatumA = "06.08." & JahrA
 
  FeiertagA(56).NameA = "Kreuzerhöhung"
  FeiertagA(56).DatumA = "14.09." & JahrA
 
  FeiertagA(57).NameA = "Fest der Erzengel Michael, Gabriel und Raphael"
  FeiertagA(57).DatumA = "29.09." & JahrA
 
  FeiertagA(58).NameA = "Allerseelen"
  FeiertagA(58).DatumA = "2.11." & JahrA
 
  FeiertagA(59).NameA = "Weißer Sonntag"
  FeiertagA(59).DatumA = DateAdd("d", 7, OsternA)
 
  FeiertagA(60).NameA = "Johannistag"
  FeiertagA(60).DatumA = "24.06." & JahrA
 
  FeiertagA(61).NameA = "Siebenschläfertag"
  FeiertagA(61).DatumA = "27.06." & JahrA
 
  FeiertagA(62).NameA = "Gründonnerstag"
  FeiertagA(62).DatumA = DateAdd("d", -3, OsternA)
 
  FeiertagA(63).NameA = "Karsamstag"
  FeiertagA(63).DatumA = DateAdd("d", -1, OsternA)
 
  FeiertagA(64).NameA = "Europatag"
  FeiertagA(64).DatumA = "05.05." & JahrA
End Sub

' Beginn der Sommerzeit berechnen
Private Function GetBeginnSommerzeit(JahrA As Long) As Date
  Dim i As Long
 
  For i = 31 To 20 Step -1
    If Format$(i & ".3." & JahrA, "ddd") = "So" Then
      GetBeginnSommerzeit = i & ".3." & JahrA
      Exit For
    End If
  Next i
End Function

' Beginn der Winterzeit berechnen
Private Function GetBeginnWinterzeit(JahrA As Long) As Date
  Dim i As Long
 
  For i = 31 To 20 Step -1
    If Format$(i & ".10." & JahrA, "ddd") = "So" Then
      GetBeginnWinterzeit = i & ".10." & JahrA
      Exit For
    End If
  Next i
End Function

' Erntedank berechnen
Private Function GetErntedankfest(JahrA As Long) As Date
  Dim i As Long
 
  For i = 1 To 16
    If Format$(i & ".10." & JahrA, "ddd") = "So" Then
      GetErntedankfest = Format$(i & ".10." & JahrA, "dd.mm.yyyy")
      Exit For
    End If
  Next i
End Function

' Muttertag berechnen
Private Function GetMuttertag(JahrA As Long) As Date
  Dim W1 As Boolean
  Dim i As Long
 
  W1 = False
  For i = 1 To 31
    If Format$(i & ".5." & JahrA, "ddd") = "So" Then
      If W1 = True Then
        GetMuttertag = Format$(i & ".5." & JahrA, "dd.mm.yyyy")
        Exit For
      Else
        W1 = True
      End If
    End If
  Next i
End Function

' 4. Advent berechnen
Private Function GetViertenAdvent(JahrA As Long) As Date
  Dim i As Long
 
  For i = 24 To 1 Step -1
    If Format$(i & ".12." & JahrA, "ddd") = "So" Then
      GetViertenAdvent = Format$(i & ".12." & JahrA, "dd.mm.yyyy")
      Exit For
    End If
  Next i
End Function

Alle Feiertage in der ListBox anzeigen

Private Sub Command1_Click()
  ' alle Feiertage in einer ListBox anzeigen
  Dim FeiertageA() As TypeFeiertag
  Dim i As Long
 
  GetAlleFeiertag 2004, FeiertageA()
  For i = 0 To 64
    List1.AddItem FeiertageA(i).DatumA & "   " & FeiertageA(i).NameA
  Next i
End Sub