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
95
96
97
98
99
100
101
102
103
| Function FinalDate(date_début As Date, nbjours As Integer, _
Optional Fériés As Boolean = True) As Date
Dim ladate As Date
ladate = CDate(date_début) + 1
While Jours_Travail(date_début, ladate, Fériés) < nbjours
ladate = DateAdd("d", 1, ladate)
Wend
FinalDate = ladate
End Function
Function Jours_Travail(BegDate As Variant, EndDate As Variant, _
Optional bAvecJFerie As Boolean = True) As Variant
Dim ladate As Date
On Error GoTo Jours_Travail_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
ladate = BegDate
Jours_Travail = 0
While ladate <= EndDate
If DatePart("w", ladate, vbMonday) < 6 And IIf(bAvecJFerie, Not Is_Férié(ladate), True) Then
Jours_Travail = Jours_Travail + 1
End If
ladate = DateAdd("d", 1, ladate)
Wend
Exit Function
Jours_Travail_Error:
Select Case Err.Number
Case vbObjectError + 1: Jours_Travail = "Les 2 dates sont obligatoires."
Case vbObjectError + 2: Jours_Travail = "Format de date incorrect."
Case vbObjectError + 3: Jours_Travail = "La date de fin doit être postérieure à la date de début."
Case Else: Jours_Travail = Err.Description
End Select
End Function
Function Is_Férié(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
Is_Férié = 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
Public Function HeuresTravail(date1 As Date, heure1 As Long, date2 As Date, heure2 As Long) As Long
diff = (Jours_Travail(date1, date2) - 1) * 10 - (heure1 - heure2)
HeuresTravail = diff
End Function
Public Sub ESSAI()
With Sheets(1)
.Range("H1").Value = Jours_Travail(.Range("A1"), .Range("A2"))
.Range("J1").Value = HeuresTravail(.Range("A1"), .Range("B1"), .Range("A2"), .Range("B2"))
End With
End Sub |
