Hallo Kaeru Gaman,
Kaeru Gaman hat geschrieben:der Code den du da hast benutzt eine spezifische Funktion von VB, die in PB nicht existiert.
da musst du dir selber was basteln.
vielen Dank für Deine Antwort. Echt klasse.
Genau diese Funktion hatte ich in PB gesucht, nur nicht gefunden. Ich dachte, dass ich nur nicht nach dem richtigen Namen gesucht habe.
Das herausfindes des Werktages ist damit kein Problem mehr.
Hättest Du noch eine Idee, wie ich herausfinde ob dieser Letzte Werktag ein Feiertag ist?
Ich hatte hierzu auch wiederum eine Funktion. Mir fällt es halt einfach nur noch ziemlich schwer das in PB umzusetzen.
Code: Alles auswählen
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
Nochmals vielen Dank für Deine Hilfe
Gruß
Michael[/code]