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
|
' Il faut mettre bAvecJFerie à False pour ne pas tenir compte des jours feriés, rien sinon.
Function Work_Days(BegDate As Variant, EndDate As Variant, _
Optional bAvecJFerie As Boolean = True) As Variant
Dim dt As Date
On Error GoTo Work_Days_Error
If IsNull(BegDate) Or IsNull(EndDate) Then Err.Raise vbObjectError + 1
If Not IsDate(BegDate) Or Not IsDate(EndDate) Then Err.Raise vbObjectError + 2
If BegDate > EndDate Then Err.Raise vbObjectError + 3
dt = BegDate
Work_Days = 0
While dt <= EndDate
If DatePart("w", dt, vbMonday) < 6 And IIf(bAvecJFerie, Not EstFerie(dt), True) Then
Work_Days = Work_Days + 1
End If
dt = DateAdd("d", 1, dt)
Wend
Exit Function
Work_Days_Error:
Select Case Err.Number
Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
Case vbObjectError + 2: Work_Days = "Format de date incorrect."
Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
Case Else: Work_Days = Err.DESCRIPTION
End Select
End Function
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
anneeDate = Year(QuelleDate)
joursFeries(1) = DateSerial(anneeDate, 1, 1)
joursFeries(2) = DateSerial(anneeDate, 5, 1)
joursFeries(3) = DateSerial(anneeDate, 5, 8)
joursFeries(4) = DateSerial(anneeDate, 7, 14)
joursFeries(5) = DateSerial(anneeDate, 8, 15)
joursFeries(6) = DateSerial(anneeDate, 11, 1)
joursFeries(7) = DateSerial(anneeDate, 11, 11)
joursFeries(8) = DateSerial(anneeDate, 12, 25)
joursFeries(9) = fLundiPaques(anneeDate)
joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Paques + 38
joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 49
For i = 1 To 11
If QuelleDate = joursFeries(i) Then
EstFerie = True
Exit For
End If
Next
End Function
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
'Adapté de +ieurs scripts...
Dim L(6) As Long, Lj As Long, Lm As Long
L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
L(4) = (19 * L(1) + 24) Mod 30
L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
L(6) = 22 + L(4) + L(5)
If L(6) > 31 Then
Lj = L(6) - 31
Lm = 4
Else
Lj = L(6)
Lm = 3
End If
' Lundi de Pâques = Paques + 1 jour
fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
End Function |
Partager