CALCULER LES FÊTES MOBILES

'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

14 avril 2007 16:14:26 :

suite a la remarque de Pasquet78 j'ai enlevé le mois de juillet

• VB6 - PROGRESSEBARRE GRAPHIQUE
• UN PETIT PROG SANS PRÉTENTION POUR METTRE EN OEUVRE DATESERIAL ET TIMESERIAL
• UN OCX PASSE-PARTOUT POUR LA SÉLECTION D'UNE COULEUR

• FUSEAUX MATIC
• AVERTISSEUR
• CREATION DU VERSION SHAREWARE
• ERYGENDA ÉTERNEL OU PRESQUE. VERSION DE BASE, SANS ATTACHEMENTS À DES DOCUMENTS
• HORLOGE 2

• CREATION DU VERSION SHAREWARE
• SUPPRESSION DE CERTAINS FICHIERS DANS UN RÉPERTOIRE PARTICULIER ET RÉCURSIVEMENT DANS SES SOUS-RÉPERTOIRES, CRÉÉS/MODIFIÉS/ACCÉDÉS A UNE CERTAINE DATE-VBS
• ERYGENDA ÉTERNEL OU PRESQUE. VERSION DE BASE, SANS ATTACHEMENTS À DES DOCUMENTS
• ASTRONOMIE
• CALCUL DE LA DATE DE PÂQUES À PARTIR DE 1583 SELON OUDIN