Bewegliche Feiertage II Dieser Tipp ermittelt die beweglichen Feiertage und zeigt zudem noch an, in welchen Bundesländern der Feiertag gültig ist.
Autor:   Richard Mittelstädt	Bewertung:     [ Jetzt bewerten ]	Views:  7.612
ohne Homepage	System:  Win9x, WinNT, Win2000, WinXP, Vista	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 18 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 3.4 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Dieser Tipp ist eine Erweiterung des Tipps  Bewegliche Feiertage und Arbeitstage eines Monats von Hermann Röttger.

Die Funktion FeiertageVomJahr ermittelt alle beweglichen Feiertage und zeigt zudem noch an, in welchen Bundesländern der Feiertag gültig ist.

Public Function FeiertageVomJahr(X As Long)
  ' Ermitteln aller Feiertage eines Jahres X
  ' ohne Oster-Sonntag und Pfingst-Sonntag.
  '                                            2005-02-13 rimi
  ' ************ Abkürzungen (offiziell! ) ********************
  ' BW: Baden-Württemberg
  ' BY: Freistaat Bayern
  ' BE: Berlin
  ' BB: Brandenburg
  ' HB: Freie Hansestadt Bremen
  ' HH: Freie und Hansestadt Hamburg
  ' HE: Hessen
  ' MV: Mecklenburg-Vorpommern
  ' NI: Niedersachsen
  ' NW: Nordrhein-Westfalen
  ' RP: Rheinland-Pfalz
  ' SL: Saarland
  ' SN: Freistaat Sachsen
  ' ST: Sachsen-Anhalt
  ' SH: Schleswig-Holstein
  ' TH: Freistaat Thüringen
  ' 
  '  *1    Fronleichnam in Sachsen:
  '        ist gesetzl. Feietag nur in bestimmten Gemeinden im Landkreis
  '        Bautzen und in der Westlausitz.
  '  *2    Fronleichnam in Thüringen:
  '        Der Innenminister kann durch Rechtsverordnung für Gemeinden
  '        mit überwiegend katholischer Bevölkerung Fronleichnam als
  '        gestzlichen Feiertag festlegen.
  '  *3    Augsburger Friedensfest ist nur in der Stadt Augsburg
  '        (im Stadtkreis) gesetzlicher Feiertag.
  '  *4    Buss- und Bettag in Sachsen:
  '        Ist ein unbezahlter Feiertag !
  '  *5    Mariä Himmelfahrt in Bayern:
  '        Wird nur von Gemeinden mit überwiegend katholischen
  '        Mitgliedern begangen.
  '        356 Gemeinden begehen diesen Feiertag nicht.
  ' *************************************************************
 
  Dim Feiertage(16, 1)
  Dim Feiertag As String
  Dim Jahr As Integer
  Dim SaSo
  Dim i As Long
 
  Jahr = X
  ' Bewegliche Feiertage ermitteln
  ' Karfreitag
  Feiertage(1, 0) = (Ostern(Jahr)) - 2
  Feiertage(1, 1) = "Karfreitag"
  ' Ostermontag
  Feiertage(2, 0) = (Ostern(Jahr)) + 1
  Feiertage(2, 1) = "Ostermontag"
  ' Pfingstmontag
  Feiertage(3, 0) = (Ostern(Jahr)) + 50
  Feiertage(3, 1) = "Pfingstmontag"
  ' Himmelfahrt
  Feiertage(4, 0) = (Ostern(Jahr)) + 39
  Feiertage(4, 1) = "Himmelfahrt"
  ' Fronleichnam
  Feiertage(5, 0) = (Ostern(Jahr)) + 60
  Feiertage(5, 1) = "Fronleichnam (BW, BY, HE, NW, RP, SL, SN*1, TH*2)"
  ' Buß- und Bettag
  ' =Mittwoch vor dem letzten Sonntag des Kirchenjahres?.....
  Feiertage(6, 0) = Weekday(CDate("24.12." & Jahr))   ' So=1....Sa=7
  ' vom 24.12.  31 und Tageszahl abziehen:
  Feiertage(6, 0) = DateAdd("d", -(31 + Feiertage(6, 0)), CDate("24.12." & Jahr))
  Feiertage(6, 1) = "Buß- und Bettag (SN*4)"
 
  ' Feste Feiertage ermitteln
  ' Neujahr
  Feiertage(7, 0) = CDate("01.01." & Jahr)
  Feiertage(7, 1) = "Neujahr"
  ' Heilige Drei Könige
  Feiertage(8, 0) = CDate("06.01." & Jahr)
  Feiertage(8, 1) = "Heilige Drei Könige (BW, BY, ST)"
  ' 1.Mai
  Feiertage(9, 0) = CDate("01.05." & Jahr)
  Feiertage(9, 1) = "1.Mai"
  ' Mariä Himmelfahrt
  Feiertage(10, 0) = CDate("15.08." & Jahr)
  Feiertage(10, 1) = "Mariä Himmelfahrt (BY*5, SL)"
  ' Tag der deutschen Einheit
  Feiertage(11, 0) = CDate("03.10." & Jahr)
  Feiertage(11, 1) = "Tag der deutschen Einheit"
  ' Reformationstag
  Feiertage(12, 0) = CDate("31.10." & Jahr)
  Feiertage(12, 1) = "Reformationstag (BB, MV, SN, ST, TH)"
  ' Allerheiligen
  Feiertage(13, 0) = CDate("01.11." & Jahr)
  Feiertage(13, 1) = "Allerheiligen (BW, BY, NW, RP, SL)"
  ' 1. Weihnachtstag
  Feiertage(14, 0) = CDate("25.12." & Jahr)
  Feiertage(14, 1) = "1. Weihnachtstag"
  ' 2.Weihnachtstag
  Feiertage(15, 0) = CDate("26.12." & Jahr)
  Feiertage(15, 1) = "2.Weihnachtstag"
  ' Augsburger Friedensfest
  Feiertage(16, 0) = CDate("08.08." & Jahr)
  Feiertage(16, 1) = "Augsburger Friedensfest (BY*3)"
 
  ' **** sortieren *****************************************************
  Dim n
  For n = 1 To UBound(Feiertage, 1)
    For i = 1 To UBound(Feiertage, 1) - 1
      If Feiertage(i + 1, 0) < Feiertage(i, 0) Then
        Feiertage(0, 0) = Feiertage(i, 0)     ' i-ten Merken in Merk-Zeile(0)
        Feiertage(0, 1) = Feiertage(i, 1)
        Feiertage(i, 0) = Feiertage(i + 1, 0) ' durch i+1-ten ersetzen
        Feiertage(i, 1) = Feiertage(i + 1, 1)
        Feiertage(i + 1, 0) = Feiertage(0, 0) ' gemerkten hochrücken !
        Feiertage(i + 1, 1) = Feiertage(0, 1)
      End If
    Next i
  Next n
  Feiertage(0, 0) = 0   '0-ten rücksetzen in Merk-Zeile(0)
  Feiertage(0, 1) = ""
 
  ' Liste erzeugen
  FeiertageVomJahr = "Gesetzliche Feiertage " & X & " (o.Garantie)" & vbNewLine
  FeiertageVomJahr = FeiertageVomJahr & "(ohne Oster- und Pfingst-Sonntag)" & vbNewLine & vbNewLine
 
  For i = 1 To UBound(Feiertage, 1)
    ' neuer Monat ? -> Leerzeile dazu
    If Month(Feiertage(i, 0)) > Month(Feiertage(i - 1, 0)) Then
      FeiertageVomJahr = FeiertageVomJahr & vbNewLine
    End If
    ' Wochentag ermitteln
    SaSo = CInt(Weekday(Feiertage(i, 0)))
    SaSo = Choose(SaSo + 1, "", "So", "Mo", "Di", "Mi", "Do", "Fr", "Sa")
    FeiertageVomJahr = FeiertageVomJahr & Feiertage(i, 0) & "   " & SaSo & "  " & Feiertage(i, 1) & vbNewLine
  Next i
End Function

Beispiel für den Aufruf:

Dim sTemp As String
Dim sData() As String
Dim i As Integer
 
' alle Feiertage im Jahr 2005 ermitteln
sTemp = FeiertageVomJahr(2005)
 
' Daten splitten
sData = Split(sTemp, vbNewLine)

' alle Feiertage in einer ListBox ausgeben, 
' mit zusätzlichen Leerzeilen zwischen den Monaten
For i = 0 To UBound(sData)
  List1.AddItem sData(i)
Next i

' alle Feiertage in einer ListBox ausgeben, 
' OHNE zusätzliche Leerzeilen
For i = 0 To UBound(sData)
  If Len(Trim$(sData(i))) > 0 Then
    List1.AddItem sData(i)
  End If
Next i