Titre du sujet : Re: Calcul nombre de jours samedi,dimanche et jours fériés entre deux dates
par JeanMarie le 22/08/2008 14:50:22
Bonjour
Exact Jean+Claude pour la mauvaise déclaration de l'élément 3 du tableau. Mais ce n'était pas la seule heure dans mon code, qui ne renvoyait pas de message d'erreur quand je l'ai créé sur mon mac.
Pour corriger le problème retournée par la function, il suffit de basculer les variables de Type Date en Long.
De plus j'ai rajouté dans la fonction de test des valeurs dates, l'effet Fête du travail et Ascension de l'année 2008.
Voici le code corrigé
Option Explicit 'JeanMarie sur mDFXLPages
''Déclaration d'un tableau de Type Date contenant 13 éléments
Dim DateFerie(13) As Long
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(2) + 1
DateFerie(4) = DateSerial(vAnnee, 5, 1)
DateFerie(5) = DateSerial(vAnnee, 5, 8)
DateFerie(6) = DateFerie(2) + 39
DateFerie(7) = DateFerie(2) + 49
DateFerie(8) = DateFerie(2) + 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 Long, vDateF As Long) 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 Long '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
'Sortie forcée de la boucle, Cas du 1/5/08 (F. du Travail et Ascension)
Exit For
End If
'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(I + 1))
Next I
NbSamediDimancheFerie = Compteur
End Function
Désolé pour ces grossières erreurs.
Pour ce qui est du code, je teste toutes les dates entre les bornes, ce qui est long. Une autre manière consisterait à utiliser la fonction DateDiff qui peut retourner le nombre de semaines entre deux bornes et tester le WeekDay des jours fériés.
@+Jean-Marie
|
Didier FOURGEOT