|
Wie berechnet man die Feiertage eines Jahres?
Erstellen Sie ein neues Modul und fügen Sie die nachfolgenden Codezeilen ein:
Option Explicit
'// ----------------------------------------------------------------
'// Feiertagsberechnung nach dem Algorithmus von Carl Friedrich Gauß
'// ----------------------------------------------------------------
Type DtFeiertage
Jahreszahl As Long
Ostern As Date
Neujahr As Date
DreiKoenige As Date
Rosenmontag As Date
Aschermittwoch As Date
Karfreitag As Date
Ostersonntag As Date
Ostermontag As Date
Maifeiertag As Date
ChrHimmelfahrt As Date
Pfingstsonntag As Date
Pfingstmontag As Date
Fronleichnam As Date
MariaeHimmelfahrt As Date
DtEinheit As Date
Reformationstag As Date
Allerheiligen As Date
Heiligabend As Date
Weihnachten1 As Date
Weihnachten2 As Date
Sylvester As Date
End Type
Dim m_uDTF As DtFeiertage |
Sub Beispiel()
Call BerechneFeiertage(Year(Now))
Debug.Print "Die Feiertage für "; Year(Now); vbCrLf
Debug.Print "Neujahr "; Format(m_uDTF.Neujahr, "Long Date")
Debug.Print "Hl. Drei Könige "; Format(m_uDTF.DreiKoenige,
_
"Long Date")
Debug.Print "Rosenmontag "; Format(m_uDTF.Rosenmontag,
_
"Long Date")
Debug.Print "Aschermittwoch ";
Format(m_uDTF.Aschermittwoch,_
"Long Date")
Debug.Print "Karfreitag "; Format(m_uDTF.Karfreitag,
_
"Long Date")
Debug.Print "Ostersonntag "; Format(m_uDTF.Ostersonntag,
_
"Long Date")
Debug.Print "Ostermontag "; Format(m_uDTF.Ostermontag,
_
"Long Date")
Debug.Print "Maifeiertag "; Format(m_uDTF.Maifeiertag,
_
"Long Date")
Debug.Print "Christi Himmelfahrt "; Format(m_uDTF._
ChrHimmelfahrt, "Long Date")
Debug.Print "Pfingstsonntag "; Format(m_uDTF._
Pfingstsonntag, "Long Date")
Debug.Print "Pfingstmontag "; Format(m_uDTF.Pfingstmontag,
_
"Long Date")
Debug.Print "Fronleichnam "; Format(m_uDTF.Fronleichnam,
_
"Long Date")
Debug.Print "Mariä Himmelfahrt ";
Format(m_uDTF._
MariaeHimmelfahrt, "Long Date")
Debug.Print "Tag der dt. Einheit "; Format(m_uDTF.DtEinheit,
_
"Long Date")
Debug.Print "Reformationstag "; Format(m_uDTF._
Reformationstag, "Long Date")
Debug.Print "Allerheiligen "; Format(m_uDTF.Allerheiligen,
_
"Long Date")
Debug.Print "Heiligabend "; Format(m_uDTF.Heiligabend,
_
"Long Date")
Debug.Print "Weihnachten1 "; Format(m_uDTF.Weihnachten1,
_
"Long Date")
Debug.Print "Weihnachten2 "; Format(m_uDTF.Weihnachten2,
_
"Long Date")
Debug.Print "Sylvester "; Format(m_uDTF.Sylvester,
_
"Long Date")
'// ----------------------------------------------------------------
'// Ausgabe:
'// ----------------------------------------------------------------
'// Neujahr Mittwoch, 1. Januar 2003
'// Hl. Drei Könige Montag, 6. Januar 2003
'// Rosenmontag Montag, 3. März 2003
'// Aschermittwoch Mittwoch, 5. März 2003
'// Karfreitag Freitag, 18. April 2003
'// Ostersonntag Sonntag, 20. April 2003
'// Ostermontag Montag, 21. April 2003
'// Maifeiertag Donnerstag, 1. Mai 2003
'// Christi Himmelfahrt Donnerstag, 29. Mai 2003
'// Pfingstsonntag Sonntag, 8. Juni 2003
'// Pfingstmontag Montag, 9. Juni 2003
'// Fronleichnam Donnerstag, 19. Juni 2003
'// Mariä Himmelfahrt Freitag, 15. August 2003
'// Tag der dt. Einheit Freitag, 3. Oktober 2003
'// Reformationstag Freitag, 31. Oktober 2003
'// Allerheiligen Samstag, 1. November 2003
'// Heiligabend Mittwoch, 24. Dezember 2003
'// Weihnachten1 Donnerstag, 25. Dezember 2003
'// Weihnachten2 Freitag, 26. Dezember 2003
'// Sylvester Mittwoch, 31. Dezember 2003
'// ----------------------------------------------------------------
End Sub |
Sub BerechneFeiertage(Jahreszahl As Integer)
'// Als Refrenzdatum zunächst m_uDTF.Ostern berechnen
If Not Ostern_berechnen(Jahreszahl) Then Exit Sub
'// Neujahr setzen (fester Feiertag am 1. Januar)
m_uDTF.Neujahr = DateSerial(Jahreszahl, 1, 1)
'// Hl. Drei Könige setzen (fester Feiertag am 6. Januar)
m_uDTF.DreiKoenige = DateSerial(Jahreszahl, 1, 6)
'// Rosenmontag berechnen
'// (beweglicher Feiertag; 48 Tage vor Ostern)
m_uDTF.Rosenmontag = m_uDTF.Ostern - 48
'// Aschemittwoch berechnen
'// (beweglicher Feiertag; 46 Tage vor Ostern)
m_uDTF.Aschermittwoch = m_uDTF.Ostern - 46
'// Karfreitag berechnen
'// (beweglicher Feiertag; 2 Tage vor Ostern)
m_uDTF.Karfreitag = m_uDTF.Ostern - 2
'// Ostersonntag = m_uDTF.Ostern!
m_uDTF.Ostersonntag = m_uDTF.Ostern
'// Ostermontag berechnen
'// (beweglicher Feiertag; 1 Tag nach Ostern)
m_uDTF.Ostermontag = m_uDTF.Ostern + 1
'// Maifeiertag setzen (fester Feiertag am 1. Mai)
m_uDTF.Maifeiertag = DateSerial(Jahreszahl, 5, 1)
'// Christi Himmelfahrt berechnen
'// (beweglicher Feiertag; 39 Tage nach Ostern)
m_uDTF.ChrHimmelfahrt = m_uDTF.Ostern + 39
'// Pfingstsonntag berechnen
'// (beweglicher Feiertag; 49 Tage nach Ostern)
m_uDTF.Pfingstsonntag = m_uDTF.Ostern + 49
'// Pfingstmontag berechnen
'// (beweglicher Feiertag; 50 Tage nach Ostern)
m_uDTF.Pfingstmontag = m_uDTF.Ostern + 50
'// Fronleichnam berechnen
'// (beweglicher Feiertag; 60 Tage nach Ostern)
m_uDTF.Fronleichnam = m_uDTF.Ostern + 60
'// Mariä Himmelfahrt setzen
'// (fester Feiertag am 15. August)
m_uDTF.MariaeHimmelfahrt = DateSerial(Jahreszahl, 8, 15)
'// Tag der deutschen Einheit setzen
'// (fester Feiertag am 3. Oktober)
m_uDTF.DtEinheit = DateSerial(Jahreszahl, 10, 3)
'// Reformationstag setzen
'// (fester Feiertag am 31. Oktober)
m_uDTF.Reformationstag = DateSerial(Jahreszahl, 10, 31)
'// Allerheiligen setzen (fester Feiertag am 1. November)
m_uDTF.Allerheiligen = DateSerial(Jahreszahl, 11, 1)
'// Heiligabend setzen (fester 'Feiertag' am 24. Dezember)
m_uDTF.Heiligabend = DateSerial(Jahreszahl, 12, 24)
'// Erster Weihnachtstag setzen
'// (fester 'Feiertag' am 25. Dezember)
m_uDTF.Weihnachten1 = DateSerial(Jahreszahl, 12, 25)
'// Zweiter Weihnachtstag setzen
'// (fester 'Feiertag' am 26. Dezember)
m_uDTF.Weihnachten2 = DateSerial(Jahreszahl, 12, 26)
'// Sylvester setzen (fester 'Feiertag' am 31. Dezember)
m_uDTF.Sylvester = DateSerial(Jahreszahl, 12, 31)
End Sub |
Function Ostern_berechnen(ByVal lYear
As Long) As Boolean
'// Berechnung mit Hilfe des Algorithmus von Gauß
On Error GoTo Err_Ostern_berechnen
Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim i5 As Integer
Dim iTZ As Integer '// iTZ = Tageszahl
i1 = lYear Mod 19 '// Formel nach Gauß
i2 = lYear Mod 4 '// Werte für die Jahre
i3 = lYear Mod 7 '// 1900 - 2099
i4 = (19 * i1 + 24) Mod 30
i5 = (2 * i2 + 4 * i3 + 6 * i4 + 5) Mod 7
iTZ = 22 + i4 + i5 '// Ermittelt den Tag
If iTZ > 31 Then '// März oder April
iTZ = iTZ - 31 '// Wenn April, dann - 31 Tage
If iTZ = 26 Then iTZ = 19 '// Wenn 26.4. dann 19.4.
If (iTZ = 25 And i4 = 28 And i1 > 10) Then iTZ = 18
m_uDTF.Ostern = DateSerial(lYear, 4, iTZ) '// Ostern im April
Else
m_uDTF.Ostern = DateSerial(lYear, 3, iTZ) '// Ostern im Maerz
End If
Ostern_berechnen = True
Exit_Ostern_berechnen:
Exit Function
Err_Ostern_berechnen:
Ostern_berechnen = False
GoTo Exit_Ostern_berechnen
End Function |
Zum Testen geben Sie in Direktbereich bzw. das Direktfenster innerhalb der Codeansicht den Text Beispiel ein und bestätigen mit der Enter-Taste. Die Funktion listet Ihnen alle Feiertage des Jahres auf.
Zurück zu Tipps und Tricks
|
|