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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
| ' Retourne le nombre de jours ouvrés
' ' =================================================================='
' Nombre de jours ouvrés
Public Function Count_OpenDays(ByVal dateBegin As Date, ByVal dateEnd As Date, Optional sCountry As String = "FR") As Long
Dim tmpDate As Date
Dim sHollidays As String, param() As Long
' Ne pas obtenir un éventuel décompte négatif
If dateBegin > dateEnd Then tmpDate = dateBegin: dateBegin = dateEnd: dateEnd = tmpDate
' Liste des jours fériés à décompter
param() = get_Holidays(dateBegin, dateEnd, sCountry)
Count_OpenDays = Application.WorksheetFunction.NetworkDays(dateBegin, dateEnd, param)
End Function
' Liste des jours fériés
Public Function get_Holidays(dateBegin As Date, dateEnd As Date, Optional zone As String = "FR") As Long()
Dim a As Integer, p As Date, b As Boolean
Dim dDate As Long, dDates() As Long, i As Long
ReDim dDates(0 To 0)
'Etablir la liste des jours fériés
For a = Year(dateBegin) To Year(dateEnd)
p = EasterMonday(a)
'Common
dDate = DateSerial2Long(a, 1, 1): b = dDate >= dateBegin And dDate <= dateEnd ' Jour de l'an
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = CLng(p) - 3: b = dDate >= dateBegin And dDate <= dateEnd ' Vendredi Saint
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = DateSerial2Long(a, 12, 25): b = dDate >= dateBegin And dDate <= dateEnd ' Noel
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
'FR
If zone = "FR" Then
dDate = CLng(p): b = dDate >= dateBegin And dDate <= dateEnd ' Lundi de Paques
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = DateSerial2Long(a, 5, 1): b = dDate >= dateBegin And dDate <= dateEnd ' 1er mai
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = DateSerial2Long(a, 5, 8): b = dDate >= dateBegin And dDate <= dateEnd ' Victoire 45
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = DateSerial2Long(a, 7, 14): b = dDate >= dateBegin And dDate <= dateEnd ' 14 Juillet
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = DateSerial2Long(a, 8, 15): b = dDate >= dateBegin And dDate <= dateEnd ' Assomption
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = DateSerial2Long(a, 11, 11): b = dDate >= dateBegin And dDate <= dateEnd ' 11 Novembre
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = DateSerial2Long(a, 12, 26): b = dDate >= dateBegin And dDate <= dateEnd ' 2ème Noel
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1 '
'US
ElseIf zone = "US" Then
dDate = nDayOfMonth(a, 1, 1, 3): b = dDate >= dateBegin And dDate <= dateEnd ' 19/01 : Martin Luther King Junior Day (3ème Lundi de Janvier)
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = nDayOfMonth(a, 2, 1, 3): b = dDate >= dateBegin And dDate <= dateEnd ' 16/02 : President’s Day (3ème Lundi de Février)
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = nDayOfMonth(a, 6, 1, 1) - 7: b = dDate >= dateBegin And dDate <= dateEnd ' 25 mai Memorial Day (Dernier Lundi de Mai)
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = DateSerial2Long(a, 6, 9): b = dDate >= dateBegin And dDate <= dateEnd ' 19 Juin Juneteenth
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = DateSerial2Long(a, 7, 4): b = dDate >= dateBegin And dDate <= dateEnd ' 04 Juillet : Independance Day
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
dDate = DateSerial2Long(a, 9, 7): b = dDate >= dateBegin And dDate <= dateEnd ' 7 septembre : Labor Day
If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = nDayOfMonth(a, 10, 1, 2, vbFriday): b = dDate >= dateBegin And dDate <= dateEnd ' 12 Octobre : Columbus Day (2ème lundi d’octobre)
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = DateSerial2Long(a, 11, 11): b = dDate >= dateBegin And dDate <= dateEnd ' 11 Novembre Veteran's Day
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
' dDate = nDayOfMonth(a, 11, 1, 4, vbThursday): b = dDate >= dateBegin And dDate <= dateEnd ' 26 Novembre : Thanksgiving Day (4ème jeudi de novembre)
' If b Then ReDim Preserve dDates(LBound(dDates) To i): dDates(i) = dDate: i = i + 1
End If
Next
get_Holidays = dDates()
End Function
' Date qualifiée par son n° de série
Public Function DateSerial2Long(a As Integer, m As Integer, j As Integer) As Long
DateSerial2Long = CLng(DateSerial(a, m, j))
End Function
' Lundi de Paques
Public Function EasterMonday(a As Integer) As Date
Dim NbO As Long, Epacte As Long
Dim PLune As Date
NbO = ((a - 532) Mod 19) + 1
Epacte = (11 * NbO - (3 + Int(2 + Int(a / 100)) * 3 / 7)) Mod 30
PLune = DateSerial(a, 4, 19) - ((Epacte + 6) Mod 30)
If Epacte = 24 Or Epacte = 25 Then PLune = PLune - 1
' Lundi de Pâques
EasterMonday = PLune - Weekday(PLune) + vbMonday + 7
End Function
' nième jour du mois
Public Function nDayOfMonth(a As Integer, m As Integer, j As Integer, n As Long, Optional wd As VbDayOfWeek = vbMonday) As Date
Dim firstDayOfMonth As Long
Dim w As Long, fd As Long, f As Long, x As Long
firstDayOfMonth = DateSerial2Long(a, m, j)
' Jour demandé base Monday =1
wd = wd + 6
' 1 jour du mois : des fois que firstDayOfMonth <> 1er du mois
fd = DateSerial2Long(a, m, 1)
w = Weekday(fd, vbMonday)
' Uniquement une date du mois concerné
For x = n To 1 Step -1
f = fd + ((wd - w) Mod 7) + ((x - 1) * 7)
If Month(f) = Month(firstDayOfMonth) Then Exit For
Next
nDayOfMonth = f
End Function |
Double soucis avec NETWORKDAYS
Répondre avec citation
Envoyé par DarkVader
Partager