Titre du sujet : Re: Calcul nombre de jours samedi,dimanche et jours fériés entre deux dates
par JeanMarie le 18/08/2008 21:49:12
Bonjour le forum
Malheureusement il n'existe pas de fonction toute faite pour répondre à ta demande.
Voici donc un code à mettre dans un module standard.
Option Explicit
'Déclaration d'un tableau de Type Date contenant 13 éléments
Dim DateFerie(13) As Date
Private Sub CreationTabFerie(vAnnee As Integer)
'Création dans un tableau des jours fériés suivant la date passée à la Sub
DateFerie(1) = DateSerial(vAnnee, 1, 1)
DateFerie(2) = PaquesVBA(vAnnee)
DateFerie(3) = DateFerie(3) + 1
DateFerie(4) = DateSerial(vAnnee, 5, 1)
DateFerie(5) = DateSerial(vAnnee, 5, 8)
DateFerie(6) = DateFerie(3) + 39
DateFerie(7) = DateFerie(3) + 49
DateFerie(8) = DateFerie(3) + 50
DateFerie(9) = DateSerial(vAnnee, 7, 14)
DateFerie(10) = DateSerial(vAnnee, 8, 15)
DateFerie(11) = DateSerial(vAnnee, 11, 1)
DateFerie(12) = DateSerial(vAnnee, 11, 11)
DateFerie(13) = DateSerial(vAnnee, 12, 25)
End Sub
Public Function PaquesVBA(vAnnee As Integer) As Date
'Calcul de la Date de Pâques
'Code transcris d'une procédures récupérée sur une Base Technique 4D
Dim D1 As Byte
Dim D2 As Integer
Dim A As Double
Dim B As Double
Dim C As Date
Dim D As Date
D1 = 0
If vAnnee < 1700 Then
D1 = 22
Else
If vAnnee < 1900 Then
D1 = 23
Else
If vAnnee < 2100 Then
D1 = 24
Else
If vAnnee < 2300 Then D1 = 25
End If
End If
End If
D2 = -1
If vAnnee < 1700 Then
D2 = 2
Else
If vAnnee < 1800 Then
D2 = 3
Else
If vAnnee < 1900 Then
D2 = 4
Else
If vAnnee < 2100 Then
D2 = 5
Else
If vAnnee < 2200 Then
D2 = 6
Else
If vAnnee < 2300 Then D2 = 0
End If
End If
End If
End If
End If
A = ((19 * (vAnnee Mod 19)) + D1) Mod 30
B = ((2 * (vAnnee Mod 4)) + (4 * (vAnnee Mod 7)) + (6 * A) + D2) Mod 7
C = DateSerial(vAnnee, 3, 22 + A + B)
If Month(C) = 4 Then
D = DateSerial(vAnnee, 4, A + B - 9)
If Day(D) = 26 Then
PaquesVBA = D - 7
Else
If (Day(D) = 25) And (A = 28) And (B = 6) And ((vAnnee Mod 19) > 10) Then
PaquesVBA = D - 7
Else
PaquesVBA = D
End If
End If
Else
PaquesVBA = C
End If
End Function
Function NbSamediDimancheFerie(vDateD As Date, vDateF As Date) As Integer
'Calcul du nombre de jours de samedi, de dimanche et jours fériés entre deux dates incluses
'vDateD est la date de début de la période
'vDateF est la date de fin de la période
Dim I As Integer'Valeur numérique correspoondant a une dateserie d'Excel
Dim J As Byte
Dim Compteur As Integer
'Initialisation du compteur
Compteur = 0
'Création du tableau des jours fériés de l'année
CreationTabFerie (Year(vDateD))
'début de la boucle
For I = vDateD To vDateF
'Test si
If WeekDay(I, 2) > 5 Then
'c'est un samedi(6) ou un dimanche (7)
Compteur = Compteur + 1
Else
'non ce n'est pas un samedi ou un dimanche
'la valeur I est-elle présente dans le tableau des jours fériés
For J = 1 To 13
'test si la valeur I a une correspondance
If DateFerie(J) = I Then Compteur = Compteur + 1
'la valeur I est inférieure au jour férié contrôlé, sortie de la boucle
If I < DateFerie(J) Then Exit For
Next J
End If
'Test si le tableau des jours fériés doit être recalculé
If Year(I) = Year(I + 1) Then CreationTabFerie (Year(vDateD) + 1)
Next I
NbSamediDimancheFerie = Compteur
End Function
J'espère que je n'ai pas dit trop de bêtises, le VBA n'étant pas mon domaine de prédilection. Didier me corrigera dès son retour. (j'y fais confiance).
Edit, j'ai oublié de préciser l'utilisation, il suffit de mettre dans une cellule la formule
=NbSamediDimancheFerie(A1;A2)
A1 ayant la date de début et A2 la date de fin (je me répète).
@+Jean-Marie
|
Didier FOURGEOT