Determine si une date est feriee

Commenter

Contenu du snippet

4 fonctions qui permettent à tous les débutants d'intégrer un code compréhensible et facilement maintenable ou extensible.
La fonction à appeller est la fonction IsFerie.
La fonction Paques provient de mon précédent POST (http://www.vbfrance.com/codes/CALCUL-DATE-PAQUES-PARTIR-1583-SELON-OUDIN_39733.aspx) c'en est donc l'extension

Source / Exemple : 


Function IsFerie(datetoanalyse As Date) As Boolean
    If Not (IsFrozen(datetoanalyse)) Then
        If Not (IsMobile(datetoanalyse)) Then
            IsFerie = False
        Else
            IsFerie = True
        End If
    Else
        IsFerie = True
    End If
End Function

Function IsFrozen(datetoanalyse As Date) As Boolean

    Dim Jour, Mois

    Jour = Day(datetoanalyse)
    Mois = Month(datetoanalyse)

    Select Case Mois
        Case 1
            'Jour de l'an
            If Jour = 1 Then IsFrozen = True
        Case 5
            'Fête du travail et Victoire
            If Jour = 1 Or Jour = 8 Then IsFrozen = True
        Case 7
            'Fête Nationale
            If Jour = 14 Then IsFrozen = True
        Case 8
            'Assomption
            If Jour = 15 Then IsFrozen = True
        Case 11
            'Toussaint et Armistice
            If Jour = 1 Or Jour = 11 Then IsFrozen = True
        Case 12
            'Noël
            If Jour = 25 Then IsFrozen = True
        Case Else
            IsFrozen = False
    End Select
End Function

Function IsMobile(datetoanalyse As Date) As Boolean

    Dim Dimanche2Paques, LundiPaques, JeudiAscension, Pentecote, LundiPentecote

    Dimanche2Paques = Paques(Year(datetoanalyse))
    LundiPaques = Dimanche2Paques + 1
    JeudiAscension = Dimanche2Paques + 39 ' le jeudi de la sixième semaine après Pâques
    Pentecote = Dimanche2Paques + 49 ' le septième dimanche après Pâques
    LundiPentecote = Pentecote + 1
    
    If datetoanalyse = Dimanche2Paques Then
        IsMobile = True
    ElseIf datetoanalyse = LundiPaques Then
        IsMobile = True
    ElseIf datetoanalyse = JeudiAscension Then
        IsMobile = True
    ElseIf datetoanalyse = Pentecote Then
        IsMobile = True
    ElseIf datetoanalyse = LundiPentecote Then
        IsMobile = True
    Else
        IsMobile = False
    End If
        
End Function

Function Paques(annee As Integer) As Date
   
    Dim G, C, C_4, E, H, K, P, Q, I, B, J1, J2, R
        
    G = annee Mod 19
    C = annee \ 100
    C_4 = C \ 4
    E = (8 * C + 13) \ 25
    H = (19 * G + C - C_4 - E + 15) Mod 30
    K = H \ 28
    P = 29 \ (H + 1)
    Q = (21 - G) \ 11
    I = (K * P * Q - 1) * K + H
    B = annee \ 4 + annee
    J1 = B + I + 2 + C_4 - C
    J2 = J1 Mod 7
    R = 28 + I - J2
    
    If R <= 31 Then
        Paques = DateValue(CStr(R) & "/3/" & CStr(annee))
    Else
        Paques = DateValue(CStr(R - 31) & "/4/" & CStr(annee))
    End If
    
End Function

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 (philgriadmin)