Jours ouvrés entre deux dates
Nombre de jours ouvrés entre deux dates
Cette fonction retourne le nombre de jours ouvrés entre deux dates renseignées.
Dans l'état, elle retourne les jours ouvrés pour la France, mais peut être facilement adapté - voir fnHolidays() - à d'autres pays ou conditions.
=> Vous avez également besoin des fonctions fnHolidays() et fnEaster() ci-dessous.
Utilisation :
X = fnWorkDays("1/1/2019", "31/12/2019")
ou plus souvent :
x = fnWorkDays([champ1], [champ2])
Public Function fnWorkDays(Date1, Date2) As Integer
' Renvoi le nombre de jours ouvrés
' Utilise la fonction fnHolidays() et fnEaster()
Dim StartDate As Date, EndDate As Date, TestDate As Date
Dim DayCounter As Integer
If Not (IsDate(Date1) And IsDate(Date2)) Then
Exit Function
Else
StartDate = Date1: EndDate = Date2
End If
TestDate = StartDate
DayCounter = 0
Do Until TestDate > EndDate
If (Weekday(TestDate) <> 6) And (Weekday(TestDate) <> 7) _
And (fnHolidays(TestDate) = False) Then
DayCounter = DayCounter + 1
End If
TestDate = DateAdd("d", 1, TestDate)
Loop
fnWorkDays = DayCounter
End Function
Public Function fnHolidays(CurDate As Date) As Boolean
Dim dPaques As Date, dLPaques As Date
dPaques = fnEaster(Year(CurDate))
dLPaques = DateAdd("d", 1, dPaques)
Select Case CurDate
Case CDate("01/01/" & Year(CurDate)) 'Jour de l'an
fnHolidays = True
Case dLPaques 'Lundi de Pâques
fnHolidays = True
Case CDate("01/05/" & Year(CurDate)) 'Fête du travail
fnHolidays = True
Case CDate("08/05/" & Year(CurDate)) 'Victoire de 1945
fnHolidays = True
Case CDate("30/05/" & Year(CurDate)) 'Ascension
fnHolidays = True
Case dPaques + 50 'Lundi de pentcôte
fnHolidays = True
Case CDate("14/07/" & Year(CurDate)) 'Fête nationale
fnHolidays = True
Case CDate("15/08/" & Year(CurDate)) 'Assomption
fnHolidays = True
Case CDate("01/11/" & Year(CurDate)) 'Toussaint
fnHolidays = True
Case CDate("11/11/" & Year(CurDate)) 'Armistie 1918
fnHolidays = True
Case CDate("25/12/" & Year(CurDate)) 'Noël
fnHolidays = True
'/ Vous pouvez adapter selon vos besoins
'/ - soit en ajoutant 2 lignes selon le modèle
'/ - soit en commentant les 2 lignes non utiles
Case Else
fnHolidays = False
End Select
End Function
Public Function fnEaster(wAn%) As Date
'Pâques est le dimanche qui suit le quatorzième jour de la
'Lune qui tombe le 21 mars ou immédiatement après
Dim wA%, wB%, wC%, wD%, wE%, wF%, wG%, wH%
Dim wI%, wJ%, wK%, wL%, wM%, wN%, wP%
wA = wAn Mod 19 'Calcul du rang de l'année dans le cycle lunaire qui a 19 ans
wB = wAn / 100 'Calcul du siècle
wC = wAn Mod 100 'Calcul du rang de l'année dans le siècle
wD = wB / 4
wE = wB Mod 4
wF = (wB + 8) / 25
wG = (wB - wF + 1) / 3
wH = (19 * wA + wB - wD - wG + 15) Mod 30
wI = wC / 4
wK = wC Mod 4
wL = (32 + 2 * wE + 2 * wI - wH - wK) Mod 7
wM = (wA + 11 * wH + 22 * wL) / 451
wN = (wH + wL - 7 * wM + 114) / 31 'détermine le mois
wP = (wH + wL - 7 * wM + 114) Mod 31 'détermine le jour
fnEaster = DateSerial(wAn, wN, wP + 1)
End Function
Catégorie : Les mémos - Dates - Heures
Page lue 2266 fois