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
| Public Function MS_NbWeek(prmDate As Date, Optional PremierJourSemaine As Long = 2) As Long
Dim PremierJour As Date
Dim ecart As Integer
Dim PremierLundi As Date
Dim PremierLundi2 As Date
' Date du 1er jour de l'année
PremierJour = DateSerial(Year(prmDate), 1, 1)
' Ecart en jours entre le 1er lundi de l'année et le 1er janvier
ecart = IIf(Weekday(PremierJour, PremierJourSemaine) = 1, 0, 8 - Weekday(PremierJour, PremierJourSemaine))
' Date du 1er Lundi de l'année
PremierLundi = DateAdd("d", ecart, PremierJour)
' Calcule la semaine
If prmDate >= PremierLundi Then
MS_NbWeek = Int((prmDate - PremierLundi) / 7) + 1
Else
PremierJour = DateSerial(Year(prmDate) - 1, 1, 1)
ecart = IIf(Weekday(PremierJour, PremierJourSemaine) = 1, 0, 8 - Weekday(PremierJour, PremierJourSemaine))
PremierLundi2 = DateAdd("d", ecart, PremierJour)
MS_NbWeek = Int((prmDate - PremierLundi2) / 7) + 1
End If
End Function
Public Function MS_NbWeekYear(prmDate As Date, Optional PremierJourSemaine As Long = 2) As Long
Dim PremierJour As Date
Dim ecart As Integer
Dim PremierLundi As Date
Dim PremierLundi2 As Date
' Date du 1er jour de l'année
PremierJour = DateSerial(Year(prmDate), 1, 1)
' Ecart en jours entre le 1er lundi de l'année
' et le 1er janvier
ecart = IIf(Weekday(PremierJour, PremierJourSemaine) = 1, 0, 8 - Weekday(PremierJour, PremierJourSemaine))
' Date du 1er Lundi de l'année
PremierLundi = DateAdd("d", ecart, PremierJour)
' Calcule la semaine
If prmDate >= PremierLundi Then
MS_NbWeekYear = Year(prmDate)
Else
MS_NbWeekYear = Year(prmDate) - 1
End If
End Function |
Partager