Jours ouvrable par mois, fériés compris

Soyez le premier à donner votre avis sur cette source.

Vue 12 711 fois - Téléchargée 450 fois

Description

J'avais besoin de savoir pour chaque mois de n'importe quelle année le nombre de jours ouvrables y compris en déduisant les jours fériés. Pour les dates fixes c'est facile (14/07 25/12 etc...) et pour les jours variables je me suis inspiré d'une source d'ici.

c'est un module qui fait tout ça. utilisation :
msgbox NbJoursOuvrables(2003,04) donnera... suspense..21 !

Dans le zip la version ASP est incluse (prèsque pareil a part quelques modifs)

Source / Exemple :


Option Explicit

'Ce module renvoie le nombre de jours Ouvrables dans un mois en tenant compte des jours fériés
'utilisation : NbJoursOuvrables(2003,04) renvoit 21 !

'ATTENTION : ne tient pas compte des jours fériés concordataires en Alsace (et moselle)
'   - le Vendredi Saint (vendredi juste avant le dimanche de paques)
'   - la St Etienne (26 décembre)
'mais ce serait facile à rajouter en cas de besoin

Public Function NbJoursOuvrables(nAnne As Integer, nMois As Integer) As Integer
    'nombre de jours ouvrable le mois. Tient compte des jours fériés !
    Dim i As Integer
    Dim Ret As Integer
    
    i = Day(DateSerial(nAnne, nMois + 1, 0))
    While i > 0
        If Weekday(DateSerial(nAnne, nMois, i), vbMonday) < 6 Then
            Ret = Ret + 1
        End If
        i = i - 1
    Wend
    
    NbJoursOuvrables = Ret - GetJoursFeries(nAnne, nMois)
End Function

Private Function GetJoursFeries(nAnne As Integer, nMois As Integer) As Integer
'retourne le nombre de jours fériés d'un mois d'une année, sauf ceux qui tombent un samedi-dimanche
    
    Dim JF(10) As Date 'la tableau de tous les jours fériés de l'année
    Dim Ret As Integer
    Dim i As Integer
    Dim DatePaques As Date

    'ces jours fériés là sont à dates fixes
    JF(0) = "01/01/" & nAnne 'Jour de l'an
    JF(1) = "01/05/" & nAnne 'Fête du travail
    JF(2) = "08/05/" & nAnne 'Victoire 1945
    JF(3) = "14/07/" & nAnne 'Fête Nationnale
    JF(4) = "15/08/" & nAnne 'Assomption
    JF(5) = "01/11/" & nAnne 'La toussaint
    JF(6) = "11/11/" & nAnne 'Armistice
    JF(7) = "25/12/" & nAnne 'Noël
    
    'on récupère la date du jour du dimanche de paques
    'mais on ne la met pas dans le tableau puisque ça tombe forcément un dimanche
    DatePaques = fPaques(nAnne)
    
    'ceux à date variable
    JF(8) = Format(DateAdd("d", 1, DatePaques), "dd/mm/yyyy") 'Lundi de paques
    JF(9) = Format(DateAdd("d", 39, DatePaques), "dd/mm/yyyy") 'Ascension (39 jours après paques)
    JF(10) = Format(DateAdd("d", 50, DatePaques), "dd/mm/yyyy") 'Pentecôte (50 jours après paques)
    
    'on compte le nombre de jour féries normalement ouvrable du mois voulu
    For i = 0 To 10
        If Month(JF(i)) = nMois Then 'ci ce jour corresponbd à notre mois
            If Weekday(JF(i), vbMonday) < 6 Then 'et en plus ce n'est pas un samedi dimanche
                Ret = Ret + 1
            End If
        End If
    Next i

    GetJoursFeries = Ret
End Function

Private Function fPaques(nAnnne As Integer) As Date
'retourne la date du dimanche de paques

'La date du dimanche de Pâques  est le premier dimanche qui suit  la première pleine
'lune qui suit  l'équinoxe  de printemps.

'(C)Patrick MOIRE, trouvé sur VBFrance.com , modifié par Olivier Risacher

    Dim a As Integer, b As Integer, c As Integer
    Dim g As Integer, h As Integer, l As Integer
    Dim m As Integer, n As Integer, p As Integer
     
    a = nAnnne Mod 19
    b = nAnnne \ 100
    c = nAnnne Mod 100
    g = (b - Int((b + 8) \ 25) + 1) \ 3
    h = (19 * a + b - Int(b \ 4) - g + 15) Mod 30
    l = (32 + 2 * (b Mod 4) + 2 * Int(c \ 4) - h - Int(c Mod 4)) Mod 7
    m = (a + 11 * h + 22 * l) \ 451
    
    n = (h + l - 7 * m + 114) \ 31
    p = (h + l - 7 * m + 114) Mod 31
    
    fPaques = DateSerial(nAnnne, n, p + 1)

End Function

Conclusion :


voila
http://www.rature.com

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
2
Date d'inscription
mardi 17 juillet 2007
Statut
Membre
Dernière intervention
30 décembre 2010

J'ai réutilisé votre code aujourd'hui pour un utilitaire dont j'avais besoin.
Il me fallait utiliser plusieurs fois la même fonction et j'ai fait le découpage suivant :
Public Sub AfficherJoursFeries(AAnnee As Integer)
Dim strMessage As String
Dim intI As Integer
Dim JF(10) As Date 'la tableau de tous les jours fériés de l'année
DatesJoursFeries AAnnee, JF()
For intI = 0 To 10
strMessage = strMessage & Format(JF(intI), "dddd dd MMMM YYYY") & vbCrLf
Next
MsgBox strMessage, vbOKOnly, "Jours fériés de " & AAnnee
End Sub

Private Sub DatesJoursFeries(AAnnee As Integer, AJF As Variant)
Dim DatePaques As Date
'ces jours fériés là sont à dates fixes
AJF(0) = CDate("01/01/" & CStr(AAnnee)) 'Jour de l'an
AJF(1) = CDate("01/05/" & CStr(AAnnee)) 'Fête du travail
AJF(2) = CDate("08/05/" & CStr(AAnnee)) 'Victoire 1945
AJF(3) = CDate("14/07/" & CStr(AAnnee)) 'Fête Nationnale
AJF(4) = CDate("15/08/" & CStr(AAnnee)) 'Assomption
AJF(5) = CDate("01/11/" & CStr(AAnnee)) 'La toussaint
AJF(6) = CDate("11/11/" & CStr(AAnnee)) 'Armistice
AJF(7) = CDate("25/12/" & CStr(AAnnee)) 'Noël
'on récupère la date du jour du dimanche de paques
'mais on ne la met pas dans le tableau puisque ça tombe forcément un dimanche
DatePaques = fPaques(AAnnee)
'ceux à date variable
AJF(8) = CDate(Format(DateAdd("d", 1, DatePaques), "dd/mm/yyyy")) 'Lundi de paques
AJF(9) = CDate(Format(DateAdd("d", 39, DatePaques), "dd/mm/yyyy")) 'Ascension (39 jours après paques)
AJF(10) = CDate(Format(DateAdd("d", 50, DatePaques), "dd/mm/yyyy")) 'Pentecôte (50 jours après paques)
End Sub

Merci pour votre contribution et la clarté de vos commentaires
Messages postés
1
Date d'inscription
mercredi 24 décembre 2003
Statut
Membre
Dernière intervention
17 janvier 2004

Merci pour ce code clair et très bien commenté. Chapeau bas.
Messages postés
7
Date d'inscription
vendredi 1 août 2003
Statut
Membre
Dernière intervention
2 août 2003

TRES BON POUR LES FANATIQUES DE L4INFORMATIQUE.
Messages postés
7
Date d'inscription
vendredi 1 août 2003
Statut
Membre
Dernière intervention
2 août 2003

TRES BON POUR LES FANATIQUES DE L4INFORMATIQUE.
Messages postés
7
Date d'inscription
vendredi 1 août 2003
Statut
Membre
Dernière intervention
2 août 2003

TRES BON POUR LES FANATIQUES DE L4INFORMATIQUE.
Afficher les 10 commentaires

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.