MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - MOF-FAQ > MOF-FAQ - Module/VBA/VBE
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 01.02.2003, 05:29   #1
Stefan Kulpa
MOF Meister
MOF Meister
Normal Wie ermittle ich die Feiertage eines Jahres?

Code:

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
Code eingefügt mit dem MOF Code Converter
Angehängte Dateien
Dateityp: txt feiertage.txt (7,7 KB, 1558x aufgerufen)

__________________

Stefan
Stefan Kulpa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.01.2004, 08:46   #2
BlaXioN
MOF User
MOF User
Standard

Hehe die Funktion könnt ich bei mir auch noch als gimick einbaun.

danke dafür
BlaXioN ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 01.08.2004, 21:58   #3
Johnny Loser
MOF Meister
MOF Meister
Standard Nicht nur für die Sachsen ....

.... mag es wichtig sein, auf welchen Tag der Buß- und Bettag fällt.

Ergänzend zum o.a. Code:

Code:

'In der Deklaration ergänzen
     BussBettag         As Date

'In der Sub BerechneFeiertage ergänzen
'// Buss- und Bettag setzen (beweglicher 'Feiertag' Mittwoch vor dem letzten Sonntag im Kirchenjahr)
    m_uDTF.BussBettag = BussBettag_Errechnen(Jahreszahl)

'Funktion zur Berechnung von Buß- und Bettag
Function BussBettag_Errechnen(ByVal lYear As Long) As Date
Dim wDay As Integer
wDay = WeekDay(CDate("24.12." & lYear))
BussBettag_Errechnen = DateAdd("d", -(31 + wDay), CDate("24.12." & lYear))
End Function

__________________

Johnny Loser

Wer lesen kann, ist klar im Vorteil!

Windows XP / 7, Access 2.0 / 97 / 2000, Office 97 / 2000 / 2007, VB 6 .............
P.S.: Helfen macht um so mehr Spaß, wenn man ein Feedback bekommt, auch wenn's mal nicht geholfen hat
Ich beantworte keine PN oder email-Anfragen, die ins Forum gehören!
Johnny Loser ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.10.2009, 19:30   #4
Taita
Neuer Benutzer
Neuer Benutzer
Standard

Guten Tag
Herzlichen Dank für den Beitrag "Feiertage berechnen" !!!
Mit wenigen redaktionellen Änderungen lässt sich der Code auch für südamerikanische Länder verwenden,
Taita ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2010, 10:14   #5
Predator21
Neuer Benutzer
Neuer Benutzer
Standard

Hallo zusammen,

wie kann ich den Feiertag und das entsprechende Datum in einer Tabelle abspeichern ? So wie es im Direktbereich ausgegeben wird...

- siehe Anhang

Danke schonmal
Miniaturansicht angehängter Grafiken
Klicken Sie auf die Grafik für eine größere Ansicht

Name:	Feiertage_speichern.PNG
Hits:	468
Größe:	86,0 KB
ID:	52951  
Predator21 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.02.2019, 23:03   #6
bert-claus
Neuer Benutzer
Neuer Benutzer
Standard

Zitat: von Predator21 Beitrag anzeigen

Hallo zusammen,

wie kann ich den Feiertag und das entsprechende Datum in einer Tabelle abspeichern ? So wie es im Direktbereich ausgegeben wird...

- siehe Anhang

Danke schonmal


Wahrscheinlich muss du die Daten so umändert das sie stimmen.
Ich glaube es gibt mehr Feiertage in Südamerika als in der EU.
bert-claus ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:56 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.