Est ce un jour férié ?

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 040 fois - Téléchargée 43 fois

Contenu du snippet

Une petite fonction qui indique si un jour est férié ou pas. Si c'est férié la fonction renvoie le nom du jour férié. Autrement, une chaine vide.

Ex : If len(fjourferie("25/11/2002") = 0 then toto ou ...
lblMsgFerie.caption = fjourferie("25/11/2002")

Merci de m'indiquer si c'est fiable ou pas !!

Source / Exemple :


Option Explicit
'--------------
'si pas jour férié = chaine vide
'autrement --> nom du jour férié
'-------------------------------
Public Function fJourFerie(ByVal dtDate As Date) As String
    
    Dim A As Integer, M As Integer, D As Integer
    Dim tmpDate As Date
    
    A = Year(dtDate): M = Month(dtDate): D = Day(dtDate)

    If M = 1 And D = 1 Then
        fJourFerie = "1er Janvier - Jour de l'Ans"
        Exit Function
    ElseIf M = 5 And D = 1 Then
        fJourFerie = "1er Mai - Fête du Travail"
        Exit Function
    ElseIf M = 5 And D = 8 Then
        fJourFerie = "8 Mai - Victoire 1945"
        Exit Function
    ElseIf M = 7 And D = 14 Then
        fJourFerie = "14 Juillet - Fête nationale"
        Exit Function
    ElseIf M = 8 And D = 15 Then
        fJourFerie = "15 Août - Assomption"
        Exit Function
    ElseIf M = 11 And D = 1 Then
        fJourFerie = "1er Novembre - Toussaint"
        Exit Function
    ElseIf M = 11 And D = 11 Then
        fJourFerie = "11 Novembre - Armistice 1918"
        Exit Function
    ElseIf M = 12 And D = 25 Then
        fJourFerie = "25 Décembre - Noël"
        Exit Function
    ElseIf Weekday(dtDate, vbMonday) = 7 Then
        fJourFerie = "Dimanche"
        Exit Function
    Else
    
        tmpDate = fLundiPaques(A)
        
        If dtDate = tmpDate Then
            fJourFerie = "Lundi de Pâques"
            Exit Function
        ElseIf dtDate = tmpDate + 38 Then
            fJourFerie = "Ascension"
            Exit Function
        ElseIf dtDate = tmpDate + 49 Then
            fJourFerie = "Lundi de Pentecôte"
            Exit Function
        End If
        
    End If
    
End Function

Private Function fLundiPaques(ByVal Iyear As Integer) As Date
    'Adapté de +ieurs scripts...
    Dim L(6) As Long, Lj As Long, Lm As Long
    
    L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
    L(4) = (19 * L(1) + 24) Mod 30
    L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
    L(6) = 22 + L(4) + L(5)
    
    If L(6) > 31 Then
        Lj = L(6) - 31
        Lm = 4
    Else
        Lj = L(6)
        Lm = 3
    End If
    
    fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
    
End Function

Conclusion :


Ce code est une adaptation de codes déjà présent sur le site...
Merci de participer à son éventuelle correction !

A+

A voir également

Ajouter un commentaire

Commentaire

erreurs404
Messages postés
117
Date d'inscription
lundi 23 octobre 2000
Statut
Membre
Dernière intervention
12 août 2009
-
merci pour ce code bien pratique en l'adaptant un peu, j'ai pu avoir le nombre de jours calendaires, ouvrés et ouvrables d'un mois.

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.