1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
|
Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
On Error GoTo Err_Work_Days
BegDate = DateValue(BegDate)
EndDate = DateValue(EndDate)
WholeWeeks = DateDiff("w", BegDate, EndDate)
DateCnt = DateAdd("ww", WholeWeeks, BegDate)
EndDays = 0
Do While DateCnt <= EndDate
if Not IsFerie(DateCnt) then and WeekDay(DateCnt, vbMonday) <> 6 and WeekDay(DateCnt, vbMonday) <> 7 then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
Work_Days = WholeWeeks * 5 + EndDays
Exit Function
Err_Work_Days:
' If either BegDate or EndDate is Null, return a zero
' to indicate that no workdays passed between the two dates.
If Err.Number = 94 Then
Work_Days = 0
Exit Function
Else
' If some other error occurs, provide a message.
MsgBox "Error " & Err.Number & ": " & Err.Description
End If
End Function
Function IsFerie(LeJour)
Annee = Year(LeJour)
Paques = fPaques(Annee) 'Cherche le jour de Pâques
LunPaq = cStr(DateAdd("d", 1, Paques)) 'En déduit les jours fériés mobiles
Ascension = cStr(DateAdd("d", 39, Paques))
LunPent = cStr(DateAdd("d", 50, Paques))
PremierJanvier = "01/01/" & Annee
PremierMai = "01/05/" & Annee
HuitMai = "08/05/" & Annee
QuatorzeJuillet = "14/07/" & Annee
QuinzeAout = "15/08/" & Annee
PremierNovembre = "01/11/" & Annee
OnzeNovembre = "11/11/" & Annee
Noel = "25/12/" & Annee
StrJour = cStr(LeJour)
if StrJour = LunPaq or StrJour = Ascension or (StrJour = LunPent and Year(LunPent) < 2005) or (StrJour = LunPent and Year(LunPent) > 2007) _
or StrJour = PremierJanvier or StrJour = PremierMai or StrJour = HuitMai _
or StrJour = QuatorzeJuillet or StrJour = QuinzeAout or StrJour = OnzeNovembre _
or StrJour = PremierNovembre or StrJour = Noel then
IsFerie = true
else
IsFerie = false
end if
End Function
Function fPaques(An)
'Calcule le jour de Pâques en fonction de l'année
a = An Mod 19
b = An \ 100
c = 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
fPaques = DateSerial(An , n , p + 1)
End Function |
Partager