CALCUL DU NOMBRE DE JOUR OUVRABLE

Private Function Nb_Jours_Ouvrables(Date_début As Date, Date_fin As
Date) As Single


'**********************************
'Code par Belegaer
'belegaer@caramail.com
'Merci de gardez mes références sur ce codes
'**********************************


          Static Temp As Double
          'Les valeurs de date notées en dur dans le code doivent êtres
au format amériquain
          'Fonction qui donne la durée en jours ouvrables entre deux dates

          'Test de validité des dates
          If IsNull(Date_début) Or IsNull(Date_fin) Then
              Nb_Jours_Ouvrables = 0
              Exit Function
          ElseIf Not IsDate(Date_début) Or Not IsDate(Date_fin) Then
              Nb_Jours_Ouvrables = 0
              Exit Function
          ElseIf Date_début > Date_fin Then
              Nb_Jours_Ouvrables = 0
              Exit Function
          End If

          'Convertion des dates en valeurs numériques (Double) format de
date interne de la machine
          Dim dblDate_Début As Double
          Dim dblDate_Fin As Double
          dblDate_Début = CDbl(Date_début)
          dblDate_Fin = CDbl(Date_fin)

          Dim Date_Courante As Date
          Dim Var As Integer

          Do Until dblDate_Début > dblDate_Fin
              Date_Courante = CDate(dblDate_Début)

              'Teste pour savoir si le jour courant est ouvrable
               If WeekDay(Date_Courante) <> 1 And WeekDay(Date_Courante)
<> 7 Then
                  'Teste des jours fériers avec dates invariables
                  Select Case Date_Courante
                      Case CDate("01/01/" & Year(Date))   'Jour de l'an
                      Case CDate("01/05/" & Year(Date))    'Fête du
travail
                      Case CDate("08/05/" & Year(Date))   'Armistice
1945
                      Case CDate("14/07/" & Year(Date))    'Fête
nationale
                      Case CDate("15/08/" & Year(Date))      '15 Aout
                      Case CDate("01/11/" & Year(Date))       '1er
Novembre
                      Case CDate("11/11/" & Year(Date))      'Armistice
1918
                      Case CDate("25/12/" & Year(Date))        'Jour de
noël
                      Case Else
                      'Certains jours ferié religieux nécessitent un
traitement spéciale
                      If Date_Catholique(Date_Courante) = False Then
                          Var = Var + 1
                      End If
                  End Select
              End If
              dblDate_Début = dblDate_Début + 1
          Loop

      Nb_Jours_Ouvrables = Var

End Function

Private Function Date_Catholique(LaDate As Date) As Boolean
'Cette fonction contrôle si le jours n'est pas un jour ferié catholique
'Toute les dates sont basées sur le Dimanche de paque

Dim Pâques As Date
Pâques = FetePaque(Year(LaDate))

    Select Case LaDate

    Case Pâques + 1 'Lundi de Pâques
    Date_Catholique = True
    Case Pâques + 39 'jeudi de l'ascension
    Date_Catholique = True
    Case Pâques + 50    'Lundi de la pentcôte
    Date_Catholique = True
    Case Else
    Date_Catholique = False
    End Select

End Function

Function FetePaque(An As Integer) As Date

 ' Calcul du jour de la fête de Paques.
 ' Code récupéré sur internet.
 ' Ecrit par :

 '**********************************
 ' Patrice MANGIN
 ' http://perso.wanadoo.fr/mangin
 ' Patrice.MANGIN@wanadoo.fr
 '**********************************
 Dim A, b, c, d, e, f, g, h, i, k, l, m, n, p As Integer

 A = Int(An Mod 19)
 b = Int(An \ 100)
 c = Int(An Mod 100)
 d = b \ 4
 e = b Mod 4
 f = (b + 8) \ 25
 g = (b - f + 1) \ 3
 h = (19 * A + b - d - g + 15) Mod 30
 i = c \ 4
 k = c Mod 4
 l = (32 + 2 * e + 2 * i - h - k) Mod 7
 m = (A + 11 * h + 22 * l) \ 451
 n = (h + l - 7 * m + 114) \ 31
 p = (h + l - 7 * m + 114) Mod 31

 FetePaque = DateSerial(An, n, p + 1)

End Function