Public Function NumeroSemaine(dateSemaine As Date) As Integer
Dim NumJour As Integer
Dim NbJour As Integer
Dim nbpremier As Integer
Dim Jour As Date
Dim DernierJourSemaine As Date
'Correspond au 1 er janvier de l'année de la date donnée
Jour = DateSerial(Year(dateSemaine), 1, 1)
'Correspond au jour dans la semaine (1 = lundi, 2 = mardi, 3 = mercredi, 4 = jeudi, etc ...)
NumJour = Weekday(Jour, vbMonday)
'Correspond au dernier jour de la semaine du 1er janvier
DernierJourSemaine = DateSerial(Year(dateSemaine), 1, 8 - NumJour)
'Si le 1er janvier est après le vendredi, la semaine du 1 er janvier n'est pas comptabilisée dans la nouvelle année
If NumJour > 5 Then
NumeroSemaine = 0
Else
'sinon elle l'est
NumeroSemaine = 1
End If
'Différence entre la date et le jour de la fin de semaine du 1er janvier
NbJour = dateSemaine - DernierJourSemaine
'Ensuite, on calcule le numéro de la semaine
'Si le calcul tombe juste, on met le résultat
If NbJour Mod 7 = 0 Then
NumeroSemaine = (NbJour / 7) + NumeroSemaine
Else
'Sinon, on, rajoute un car il y a une semaine en cours
NumeroSemaine = NumeroSemaine + Int(NbJour / 7) + 1
End If
'Si le numéro est égal à 53, on vérifie où se trouve le 1er janvier
If NumeroSemaine = 53 Then
nbpremier = Weekday(DateSerial(Year(dateSemaine) + 1, 1, 1), vbMonday)
'Si le 1er tombe avant le vendredi, le numéro de la semaine est le numéro 1
If nbpremier < 5 Then NumeroSemaine = 1
'sinon, le numéro est le 53
End If
'Le numéro de la semaine peut être egale à 0 (01/01/2005)
'car il ne detécte pasla semaine 53
'On cherche alors le numéro de la semaine du 31/12 de l'année d'avant
If NumeroSemaine = 0 Then
'Sauf si le 01/01 est le lundi
If nbpremier = 1 Then
NumeroSemaine = 1
Else
NumeroSemaine = NumeroSemaine(DateSerial(Year(dateSemaine) - 1, 12, 31))
End If
End If
End Function