Fonction joursfériés (fixes et mobiles) jusqu'en 2030 utilisable en vba excel, access, word ou vb6

Soyez le premier à donner votre avis sur cette source.

Vue 11 275 fois - Téléchargée 867 fois

Description

Il s'agit d'une petite fonction toute simple mais bien pratique qui renvoie vrai ou faux suivant que la date transmise est un jour férié (fixe ou mobile) ou non. Très pratique à utiliser avec des mises en forme conditionnelles d'Excel ou Access. Elle n'utilise pas d'algorithme complexe pour calculer la date de Pâques. Je me suis contenté d'aller chercher sur le site de l'Institut de Mécanique Céleste et de Calcul des Éphémérides (IMCCE) les dates de Pâques jusqu'en 2030 (je me suis arrêté en 2030 car j'aurai 80 ans cette année là, mais vous pouvez aller plus loin car sur le site de l'IMCCE on peut trouver le jour de Pâques jusqu'en 2500... et qui sait si VB existera encore en 2031...). Ce n'est peut-être pas très élégant mais cela a le mérite d'être simple et à la portée de tous

Source / Exemple :


' Cette fonction renvoie Vrai si la date transmise est un jour férié
' fixe ou mobile
' les lundis de paques ne sont pas calculés mais trouvés sur le site
' de l'Institut de Mécanique Céleste et de Calcul des Ephémérides (IMCCE)
' par exemple

Function Ferie(UneDate As Long, Optional DimanchesOuiNon As Boolean) As Boolean
    ' Par défaut la fonction ne considère pas que les Dimanche de Pâques 
    ' et de Pentecôte sont fériés
    ' il suffit de renseigner l'argument DimanchesOuiNon à True à l'appel de la fonction
    ' pour les considérer comme fériés
    If IsNull(DimanchesOuiNon ) Then DimanchesOuiNon = False
    End If
    Dim JFF         ' table des fériés fixes (jours)
    Dim MFF         ' table des fériés fixes (mois)
    JFF = Array(1, 1, 8, 14, 15, 1, 11, 25)
    MFF = Array(1, 5, 5, 7, 8, 11, 11, 12)
    Dim J As Long
    Ferie = False
    ' Recherche dans la table des jours fériés fixes
        For J = 0 To 7
            If Day(UneDate) = JFF(J) And Month(UneDate) = MFF(J) Then
                Ferie = True
                Exit Function
            End If
        Next J
        Dim FM  ' contient les dates des lundis de Paques
        FM = Array(38824, 39181, 39531, 39916, 40273, 40658, 41008, _
            41365, 41750, 42100, 42457, 42842, _
            43192, 43577, 43934, 44291, 44675, _
            45026, 45383, 45768, 46118, 46475, _
            46860, 47210, 47595)

    ' Recherche si la date est un lundi de paques 
    ' ou jeudi de l'ascension 
    ' ou lundi de pentecôte
        For J = 0 To 24 ' à changer si vous allez au delà de 2030
            If (UneDate = FM(J)) Or (UneDate = FM(J) + 38) Or (UneDate = FM(J) + 49) Then
                Ferie = True
                Exit Function
            End If
            ' si DimanchesOuiNon est vrai
            ' on teste les dimanches de Pâques et Pentecote
            If DimanchesOuiNon Then
                If (UneDate = FM(J) - 1) Or (UneDate = FM(J) + 48) Then
                    Ferie = True
                    Exit Function
                End If
            End If
        Next J
End Function

Conclusion :


Vous pouvez par exemple placer cette fonction dans votre classeur Perso.xls pour l'avoir à disposition dans tous vos classeurs et l'utiliser comme n'importe quelle fonction intégrée d'Excel.

Le Zip contient un petit classeur d'exemple avec un calendrier perpétuel

Bon Codage
Jean

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
82
Date d'inscription
samedi 13 décembre 2003
Statut
Membre
Dernière intervention
14 avril 2012

Bonjour Renfield

Merci du renseignement, c'est en effet un peu plus élégant.

Et à l'intention des débutants auxquels s'adresse ce code :

Je m'aperçois que j'ai oublié de commenter dans mon code l'utilisation des valeurs numériques dans l'instruction FM=Array(38824,...).

Il s'agit, bien entendu des valeurs numériques (DateSerial) des dates des lundis de Pâques. Cela me permet une initialisation plus facile du tableau des LdP (les dates entrées dans Excel et mises au format standard ont ensuite été copiées/collées dans le code. Quelques Suppr et quelques virgules et le tableau est initialisé). Pas très parlant dans le code mais bien pratique...

Nerim
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
65
If IsNull(DimanchesOuiNon ) Then DimanchesOuiNon = False

....
tu peux faire, plutot:
Optional DimanchesOuiNon As Boolean = False (ce qui, de toutes facon est la valeur par défaut)

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.