Calculer les fêtes mobiles

Commenter

Contenu du snippet

Ont à tous étés confronter, lorsqu'ont émule un quelconque calendrier avec les jours fériés, à la date de Pâques et des suivantes, ce petit programme vous donne les dates de la fête de Pâques, l'ascention, la pentecôte et d'autre qui sont tributaires de Pâques de 1900 à 2099

Source / Exemple : 


'modulename = Module_Paques
'valable de 1900 à 2099

'La fonction retourne la date de Pâques dans les deux premier signes et le mois dans les
'deux suivant ex: 2803 pour le 28 mars
'an est l'année à calculer
'Vendredi saint -3
'jeudi de l'Ascension (jeudi de la sixième semaine après
'Pâques, soit le 39e jours après Pâques)
'Pentecôte +50
'Fête-Dieu (jeudi qui suit la Trinité, soit le 60e jour après Pâques)
Option Explicit
Type ERGpaques
    J_Paques As Integer 'jour
    M_Paques As Integer 'mois
    J_ascension As Integer
    M_ascension As Integer
    J_pentecote As Integer
    M_pentecote As Integer
    'si trinité et/ou fête-dieu, ajouter ces variables
    'et les traités dans la fonction
End Type
Public DTpaq As ERGpaques

'Les données sont aussi renvoyées dans la variable type DTpaq.
Function CalculerPaques(an As Integer) As String
Dim n As Integer
Dim a As Integer, b As Single, c As Integer
Dim e As Single, x As Single, y As Single
Dim u As Single, d As Integer, P As Integer
Dim PA$, DA As Long, DAT As Date
Dim v As Integer
    n = an - 1900:  a = n - (Fix((n / 19)) * 19)
    b = Fix(((a * 7) + 1) / 19): u = (11 * a) - b + 4
    c = ((11 * a) - b + 4) - (Int(u / 29) * 29)
    d = Int(n / 4): u = n - c + d + 31
    y = Int(u / 7) * 7
    e = u - y
    P = 25 - c - e
    If P > 0 Then
        PA$ = "0" & P: DTpaq.J_Paques = P: DTpaq.M_Paques = 4
        PA$ = Right$(PA$, 2): PA$ = PA$ & "04"
    Else
        DTpaq.J_Paques = (31 + P): DTpaq.M_Paques = 3
        PA$ = "0" & (31 + P): PA$ = Right$(PA$, 2)
        PA$ = PA$ & "03"
    End If
    CalculerPaques = PA$
    'calculer ascention
    DA = DateSerial(an, DTpaq.M_Paques, DTpaq.J_Paques) + 39
    DAT = DA: DTpaq.J_ascension = Day(DAT): DTpaq.M_ascension = Month(DAT)
    
    'calculer la Pentecôte
    DA = DateSerial(an, DTpaq.M_Paques, DTpaq.J_Paques) + 50
    DAT = DA: DTpaq.J_pentecote = Day(DAT): DTpaq.M_pentecote = Month(DAT)

End Function

'forme de test de la fonction
'FormeName=Form_Paques
' mettre 3 label - Label1, label2 et label3
' mettre un textbox - Text1
Option Explicit
Dim Mois(6) As String

Private Sub Form_Load()
Mois(3) = "Mars"
Mois(4) = "Avril"
Mois(5) = "Mai"
Mois(6) = "Juin"
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim a$, j As Integer, m As Integer
Dim b As Integer

    If KeyCode = 13 Then ' (ENTER)
        b = Val(Text1.Text)
        If b < 1900 Or b > 2099 Then
            Text1.Text = ""
            Beep
            Exit Sub
        End If
        a$ = CalculerPaques(b)
        Text1.Text = ""
        Label1.Caption = "La date de Pâques en " & b & " est le " & DTpaq.J_Paques & " " & Mois(DTpaq.M_Paques)
        Label2.Caption = "L'Ascension le " & DTpaq.J_ascension & " " & Mois(DTpaq.M_ascension)
        Label3.Caption = "La Pentecôte le " & DTpaq.J_pentecote & " " & Mois(DTpaq.M_pentecote)
        Text1.SetFocus
    End If
End Sub

Conclusion :


la fonction n'est pas compliquée, il fallait juste trouver les repères.Celà dit, il est possible de renvoyer toute les dates dans la fonction. Un peu de modif..

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_lermite222)