AW: Monatskalender Wochenende markieren
16.11.2005 17:56:43
Fritz
Hallo Markus,
vielleicht helfen Dir diese 3 Funktionen.
Bei Übergabe eines Datums ermittelt es, ob es ein Feiertag ist (Funktion "IstFeiertag" und Funktion "HolOsterDatum").
Die Funktion "WoEnde" ermittelt anhand des Datums, ob es ein SA oder SO ist
Gruß
Fritz
Function IstFeiertag(Datum As Date) As Boolean
'Prüft, ob das angegebene Datum ein gesetzlicher
'Feiertag ist, und liefert ggf. dessen Namen zurück
Dim Osterdatum As Date
If Day(Datum) = 1 And Month(Datum) = 1 Then
IstFeiertag = True
Feiertag = "Neujahr"
Exit Function
ElseIf Day(Datum) = 1 And Month(Datum) = 5 Then
IstFeiertag = True
Feiertag = "1. Mai"
Exit Function
ElseIf Day(Datum) = 3 And Month(Datum) = 10 Then
IstFeiertag = True
Feiertag = "Tag der Deutschen Einheit"
Exit Function
ElseIf Day(Datum) = 25 And Month(Datum) = 12 Then
IstFeiertag = True
Feiertag = "1. Weihnachtstag"
Exit Function
ElseIf Day(Datum) = 26 And Month(Datum) = 12 Then
IstFeiertag = True
Feiertag = "2. Weihnachtstag"
Exit Function
ElseIf Day(Datum) = 24 And Month(Datum) = 12 Then
IstFeiertag = True
Feiertag = "Heiligabend"
Exit Function
ElseIf Day(Datum) = 31 And Month(Datum) = 12 Then
IstFeiertag = True
Feiertag = "Silvester"
Exit Function
Else
Osterdatum = HolOsterdatum(Year(Datum))
If Datum = Osterdatum - 2 Then
IstFeiertag = True
Feiertag = "Karfreitag"
Exit Function
ElseIf Datum = Osterdatum Then
IstFeiertag = True
Feiertag = "Ostersonntag"
Exit Function
ElseIf Datum = Osterdatum + 1 Then
IstFeiertag = True
Feiertag = "Ostermontag"
Exit Function
ElseIf Datum = Osterdatum + 39 Then
IstFeiertag = True
Feiertag = "Himmelfahrt"
Exit Function
ElseIf Datum = Osterdatum + 49 Then
IstFeiertag = True
Feiertag = "Pfingstsonntag"
Exit Function
ElseIf Datum = Osterdatum + 50 Then
IstFeiertag = True
Feiertag = "Pfingstmontag"
Exit Function
End If
End If
IstFeiertag = False
End Function
Function HolOsterdatum(Jahr As Integer) As Date
'Berechnet das Osterdatum eines Jahres nach Carl Friedrich Gauß
Dim a As Integer, b As Integer, c As Integer
Dim d As Integer, e As Integer
Dim Tag As Integer, Monat As Integer
a = Jahr Mod 19
b = Jahr Mod 4
c = Jahr Mod 7
d = (19 * a + 24) Mod 30
e = (2 * b + 4 * c + 6 * d + 5) Mod 7
Tag = 22 + d + e
Monat = 3
If Tag > 31 Then
Tag = d + e - 9
Monat = 4
ElseIf Tag = 26 And Monat = 4 Then
Tag = 19
ElseIf Tag = 25 And Monat = 4 And d = 28 And e = 6 And a > 10 Then
Tag = 18
End If
HolOsterdatum = DateSerial(Jahr, Monat, Tag)
End Function
Function WoEnde(Datum As Date) As String
WoEnde = (Format(Day(Datum) & "." & Month(Datum) & "." & Year(Datum), "DDDD"))
End Function