Recherche
Recherche
Les mémos
 ↑  
Je débute...
Visites

 992295 visiteurs

 1 visiteur en ligne

Jours fériés

Cette fonction permet de savoir si un jour est férié, sans avoir à les gérer dans une table !!

=> Vous avez également besoin de la fonction "fnPaques"  (voir plus bas...)

Function IsFerie(Jour As Variant) As Boolean
    'd'après Ole P Erlandsen
    Dim ListeFeries(1 To 11) As Long, i As Integer
    Dim tDate As Long, annee As Integer

    IsFerie = False
    tDate = CDate(Jour)

    If tDate < 1 Then Exit Function
    annee = Year(tDate)
    If annee < 1900 Then Exit Function

    'remplit la liste des fériés
    ListeFeries(1) = CDate("1/1/" & annee)    'Jour de l'An
    ListeFeries(2) = fnPaques(annee) + 1    'Lundi de Pâques
    ListeFeries(3) = ListeFeries(2) + 38    'Jeudi Ascension
    ListeFeries(4) = ListeFeries(2) + 49    'Lundi Pentecôte
    ListeFeries(5) = CDate("1/5/" & annee)    '1er Mai
    ListeFeries(6) = CDate("8/5/" & annee)    '8 Mai
    ListeFeries(7) = CDate("14/7/" & annee)    '14 Juillet
    ListeFeries(8) = CDate("15/8/" & annee)    '15 Août
    ListeFeries(9) = CDate("1/11/" & annee)    'Toussaint
    ListeFeries(10) = CDate("11/11/" & annee)    '14-18
    ListeFeries(11) = CDate("25/12/" & annee)    'Noël

    ' compare la date entrée avec la Liste des Fériés
    i = 1
    While i <= UBound(ListeFeries) And IsFerie = False
        If tDate = ListeFeries(i) Then IsFerie = True
        i = i + 1
    Wend
End Function

Fonction qui retourne la date de pâques selon l'année transmise : 

Public Function fnPaques(wAn%) As Date
    'Pâques est le dimanche qui suit le quatorzième jour de la
    'Lune qui tombe le 21 mars ou immédiatement après

    '** A titre d'info :************'
    '** dtVenSaint = fPaques - 2****'
    '** dtLunPaq = fPaques + 1******'
    '** dtAscension = fPaques + 39**'
    '** dtDimPent = fPaques + 49****'
    '** dtLunPent = fPaques + 50****'

    Dim wA%, wb%, wC%, wD%, wE%, wF%, wG%, wH%
    Dim wI%, wJ%, wK%, wL%, wM%, wN%, wP%

    wA = wAn Mod 19    'Calcul du rang de l'année dans le cycle lunaire qui a 19 ans
    wb = wAn \ 100    'Calcul du siècle
    wC = wAn Mod 100    'Calcul du rang de l'année dans le siècle
    wD = wb \ 4
    wE = wb Mod 4
    wF = (wb + 8) \ 25
    wG = (wb - wF + 1) \ 3
    wH = (19 * wA + wb - wD - wG + 15) Mod 30
    wI = wC \ 4
    wK = wC Mod 4
    wL = (32 + 2 * wE + 2 * wI - wH - wK) Mod 7
    wM = (wA + 11 * wH + 22 * wL) \ 451
    wN = (wH + wL - 7 * wM + 114) \ 31    'détermine le mois
    wP = (wH + wL - 7 * wM + 114) Mod 31    'détermine le jour
    fnPaques = DateSerial(wAn, wN, wP + 1)

End Function

Catégorie : Les mémos - Dates - Heures
Page lue 7658 fois