Code - Visual Basic Research Center

~ Edito ~

12/03/2006 @ 13:39
Depuis la dernière mise à jour (qui remonte à... oulala plusieurs mois), un petit ménage de printemps s'impose. Ca tombe bien, c'est presque la période.
Au menu, et progressivement sur les jours à venir, rafraîchissement de plusieurs fonctions et procédures, nouvelles APIs et nouveaux programmes.

~ Rechercher ~

~ Annuaire VB ~

~ Partenaires ~

Retour à la liste des fonctions

Fonction : JourFerie
Permet de savoir si un jour est férié ou non (calcul des jours fériés variables).
(Consulté 20847 fois.)

' Cette fonction utilise les fonctions Min et Max que l'on peut trouver
' également dans la rubrique Code.
Function JourFerie(dtDate As Date, Optional blSamediFerie As Boolean = True)
' Cette fonction indique si la je jour passé en argument est férié.
' Par défaut les samedi sont considérés comme férié, mais le second
' paramètre permet de changer cela.
Dim lgA As Long, lgMPaq As Long, lgJPaq As Long
Dim lgTmp1 As Long, lgTmp2 As Long, lgTmp3 As Long
Dim stDate As String, dtPaq As Date
Dim blFerie As Boolean

' Dimanche (et samedi)
blFerie = (Weekday(dtDate) = vbSunday) Or _
           ((Weekday(dtDate) = vbSaturday) And blSamediFerie)

If Not blFerie Then
    stDate = Format(dtDate, "ddmm")
    ' Jours fériés fixes (1er janvier, 1er mai, 8 mai, 14 juillet, ...)
    blFerie = (InStr(1, ".0101.0105.0805.1407.1508.0111.1111.2512.", stDate) > 0)
End If

If Not blFerie Then
    lgA = year(dtDate)
    lgTmp1 = (19 * (lgA Mod 19) + 24) Mod 30
    lgTmp2 = Min(lgTmp1, Max(28, lgTmp1) - 1)
    lgTmp3 = 28 + lgTmp2 - ((3 + lgA - 1900 + Int((lgA - 1900) / 4) + lgTmp2) Mod 7)
    lgMPaq = 3 + (lgTmp3 \ 32)
    If (lgTmp3 < 32) Then lgJPaq = lgTmp3 Else lgJPaq = lgTmp3 - 31
    ' Construction de la date
    dtPaq = DateSerial(lgA, lgMPaq, lgJPaq)
    ' Jours fériés mobiles (lundi de pâques, ascension, lundi de pentecôte)
    ' Pâques et Pentecôte non testés, puisqu'ils tombent tous les deux un dimanche.
    blFerie = (dtDate = (dtPaq + 1)) Or (dtDate = (dtPaq + 39)) Or (dtDate = (dtPaq + 50))
End If
JourFerie = blFerie
End Function

Retour à la liste des fonctions