1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
| Public Function NumeroSemaine(ParamMaDate As DateTime) As Integer
' Norme internationale ISO-8601 : http://www.auduteau.net/calendar/cal5.shtml
' Cf. Paragraphe : 5.8 Comment calculer le numéro de semaine ?
Dim iNumSemaine As Integer
Dim iNumeroJourJulien As Integer = 0
Dim iCalculJuliena As Integer, iCalculJulieny As Integer, iCalculJulienm As Integer
Dim id1 As Integer, id4 As Integer, iL As Integer
' Calcul du numéro de semaine du calendrier Julien ...
iCalculJuliena = (14 - ParamMaDate.Month) / 12
iCalculJulieny = ParamMaDate.Year + 4800 - iCalculJuliena
iCalculJulienm = ParamMaDate.Month + 12 * iCalculJuliena - 3
iNumeroJourJulien = ParamMaDate.Day + (153 * iCalculJulienm + 2) / 5 + 365 * iCalculJulieny + iCalculJulieny / 4 - iCalculJulieny / 100 + iCalculJulieny / 400 - 32045
id4 = (iNumeroJourJulien + 31741 - (iNumeroJourJulien Mod 7)) Mod 146097 Mod 36524 Mod 1461
iL = id4 / 1460
id1 = ((id4 - iL) Mod 365) + iL
' Calcul du numéro de semaine "classique" ...
iNumSemaine = id1 / 7 + 1
Return iNumSemaine
End Function |
