| |

Fortgeschrittene ProgrammierungRe: Falsche Ausgabe der KW 01 von 2008 | |  | Autor: me36835 | Datum: 21.12.07 10:18 |
| Hallo,
da wir schon einmal bei Kalenderfunktionen sind, hier noch etwas zu Feiertagen (zwei Beiträge weil zu Lang für einen):
Public Function bew(ByVal Jahr As Integer, ByVal Feiertag As String)
Dim OM, OT, M, N, a, b, C, d, E As Integer
' http://www.salesianer.de/util/kalfaq.html#B2
' B.2 Wie kann man überhaupt die beweglichen Feste berechnen?
' Das Schwierigste ist sicher die Berechnung des Osterfestes. Diese Seite
' verwendet dazu die Gauß'sche Osterformel, angewendet auf den Julianischen _
bzw. Gregorianischen Kalender. Auf den Seiten der PTB kann man die Osterformel _
nachlesen. Näheres zur Osterfestberechnung siehe auch unter Frage B.7.
' Die Ostkirchen (mit Ausnahme eines Teils der unierten Kirchen) haben heute
' allerdings einen anderen Ostertermin, da sie die gregorianische
' Kalenderreform nicht mitgemacht haben. Ferner haben in der Aufklärungszeit
' einige protestantische Kirchen (auch in Deutschland) vorübergehend eine
' andere Art der Berechnung des Ostertermins verwendet, so dass sie in einigen
' wenigen Fällen Ostern an einem anderen Datum feierten.
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' -------------------------------
' Verwendeter Algorithmus zur Errechnung des Osterdatums (BASIC-Darstellung,
' alle Variablen integer oder long):
' http://www.uni-bamberg.de/ktheo/liturgie/@fkal.html#algorithmus
Select Case Jahr
Case 1700 To 1799
M = 23
N = 3
Case 1800 To 1899
M = 23
N = 4
Case 1900 To 2099
M = 24
N = 5
Case 2100 To 2199
M = 24
N = 6
Case Else
bew = "Syntax(yyyy,'t')"
Exit Function
End Select
a = Jahr Mod 19
b = Jahr Mod 4
C = Jahr Mod 7
d = (19 * a + M) Mod 30
E = (2 * b + 4 * C + 6 * d + N) Mod 7
' OM= Monat des Ostersonntags
OM = 3
' OT=Tag des Ostersonntags
OT = 22 + d + E
If OT > 31 Then
OT = OT - 31
OM = 4
If OT = 26 Then OT = 19
If OT = 25 And d = 28 And a > 10 Then OT = 18
End If
bew = DateValue(str(OT) & "/" & str(OM) & "/" & str(Jahr))
Select Case Feiertag
Case "1" ' 1. Advent
bew = CDate("25/12/" & str(Jahr))
bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
bew = bew - 21
Case "2" ' 2. Advent
bew = CDate("25/12/" & str(Jahr))
bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
bew = bew - 14
Case "3" ' 3. Advent
bew = CDate("25/12/" & str(Jahr))
bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
bew = bew - 7
Case "4" ' 4. Advent
bew = CDate("25/12/" & str(Jahr))
bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
Case "a" ' Aschermittwoch (-46)
bew = bew - 46
Case "b" ' Buß- & Bettag
bew = CDate("25/12/" & str(Jahr))
bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
bew = bew - 32
Case "c" ' Christi Himmelfahrt (+39)
bew = bew + 39
Case "f" ' Fronleichnam (+60)
bew = bew + 60
Case "h" ' Herz-Jesu-Freitag (+68)
bew = bew + 68
Case "k" ' Karfreitag (-2)
bew = bew - 2
Case "m" ' Pfingstmontag (+50)
bew = bew + 50
Case "o" ' Ostermontag (+1)
bew = bew + 1
Case "p" ' Pfingstsonntag (+49)
bew = bew + 49
Case "r" ' Rosenmontag (-48)
bew = bew - 48
Case "s" ' Ostersonntag (+-0)
bew = bew
Case "w" ' Weiberfastnacht (-52)
bew = bew - 52
Case Else
bew = "Syntax(yyyy,'t'); t is" & vbLf & _
"a - Aschermittwoch" & vbLf & _
"b - Buß- & Bettag" & vbLf & _
"c - Christi Himmelfahrt" & vbLf & _
"f - Fronleichnam" & vbLf & _
"h - Herz-Jesu-Freitag" & vbLf & _
"k - Karfreitag" & vbLf & _
"m - Pfingstmontag" & vbLf & _
"o - Ostermontag" & vbLf & _
"p - Pfingstsonntag" & vbLf & _
"r - Rosenmontag" & vbLf & _
"s - Ostersonntag" & vbLf & _
"w - Weiberfastnacht"
End Select
' Der Muttertag ist der zweite Sonntag im Mai
' Erntedankfest der erste Sonntag im Oktober (jedoch nicht überall!)
' Der 1. Advent ist der Sonntag nach dem 26. November
' der Buß- und Bettag liegt 11 Tage vor dem 1. Advent.
' Wobei J = Jahreszahl(vierstellig)
' Der Algorithmus geht auf den Mathematiker und Astronomen Carl Friedrich Gauß (
' 1777-1855) zurück.
End Function |  |
 | Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
  |
|
sevOutBar 4.0 
Vertikale Menüleisten á la Outlook
Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. Weitere InfosTipp des Monats Oktober 2025 Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) Access-Tools Vol.1 
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|
|
|
Copyright ©2000-2025 vb@rchiv Dieter Otter Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|