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
| Sub subSemaine(ByVal LaDate As Date, ByRef An As Integer, ByRef Semaine As Integer, ByRef Jour As Integer)
'calcule année, semaine et jour d'une date, suivant norme ISO 8601
Dim Jour4Janv As Integer 'jour de la semaine du 4 janvier, ce jour est en semaine 1 de l'année
Dim Jour28Dec As Integer 'jour de la semaine du 28 dec, ce jour est en dernière semaine de l'année
Dim DateJour1 As Date 'date du 1er X de l'année, X = le jour de semaine de la date
Dim DateJourZ As Date 'date du dernier X de l'année, X = le jour de semaine de la date
Dim i As Integer
Jour = Weekday(LaDate, vbMonday)
Jour4Janv = Weekday(DateSerial(Year(LaDate), 1, 4), vbMonday)
DateJour1 = DateSerial(Year(LaDate), 1, 4) + Jour - Jour4Janv
Jour28Dec = Weekday(DateSerial(Year(LaDate), 12, 28), vbMonday)
DateJourZ = DateSerial(Year(LaDate), 12, 28) + Jour - Jour28Dec
'si LaDate est > DateJourZ, c'est en semaine 1 de l'année suivante
If LaDate > DateJourZ Then
An = Year(LaDate) + 1
Semaine = 1
'si LaDate est < DateJour1, c'est en dernière semaine de l'année précédente, soit la semaine du 28/12/A-1
ElseIf LaDate < DateJour1 Then
Call subSemaine(DateSerial(Year(LaDate) - 1, 12, 28), An, Semaine, i)
'sinon c'est une semaine de l'année
Else
An = Year(LaDate)
Semaine = 1 + (LaDate - DateJour1) / 7
End If
End Sub |
Partager