Rubrik: Datum/Zeit und Timer · Datums- und Zeitfunktionen | VB-Versionen: VB6 | 08.04.05 |
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: | Views: 20.520 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
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