calcul semaine par macro

Function NOSEM(D As Date) As Long 'Renauder sur XLD
   D = Int(D)
   NOSEM = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
   NOSEM = ((D - NOSEM - 3 + (Weekday(NOSEM) + 1) Mod 7)) \ 7 + 1
End Function

Public Function NumSemaine(D As Date) 'Renauder sur XLD
Dim t As Long
  t = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
  NumSemaine = ((D - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
End Function

Public Function Nodesem(D As Date) ' (appel avec D="jj/mm/aaaa") 'Michel_M sur XLD
'calcul 1'jour de l'année: 1=Lundi...7=Dimanche
A = Year(D): M = 1: J = 1: If M < 3 Then M = M + 12: A = A - 1
X = J + A + (M * 2) + Int((M + 1) * 3 / 5) + Int(A / 4) - 1: NoDuPremJr = (X Mod 7) + 1
'calcul jours écoulés entre le 1'janv à ce jour (ajouter le NoDuPremJr)
Dim D1 As Date, D2 As Date
D1 = 1 & " " & 1 & " " & Year(D): D2 = Day(D) & " " & Month(D) & " " & Year(D)
NbrDeJrs = DateDiff("d", D1, D2) + NoDuPremJr
NbrDeSem = NbrDeJrs \ 7: If NbrDeJrs / 7 > NbrDeSem Then NbrDeSem = NbrDeSem + 1 'test+fiable que Cint()
Nodesem = NbrDeSem
End Function

Function NumSem(DateJour As Date) As Long 'tototiti2008 sur XLD
'Calcule le numéro de semaine d'une année suivant cette norme :
'la semaine du 1er janvier n'est la semaine 1 que si elle contient au moins 4 jours
'la semaine commence le lundi
Dim PremJanv As Date, PremJanvSuiv As Date, DateSem1 As Date, DateSem1Suiv As Date
    PremJanv = DateSerial(Year(DateJour), 1, 1)
    PremJanvSuiv = DateSerial(Year(DateJour) + 1, 1, 1)
    If Weekday(PremJanv, vbMonday) <= 4 Then
        DateSem1 = PremJanv - Weekday(PremJanv, vbMonday) + 1
    Else
        DateSem1 = PremJanv + 8 - Weekday(PremJanv, vbMonday)
    End If
    If Weekday(PremJanvSuiv, vbMonday) <= 4 Then
        DateSem1Suiv = PremJanvSuiv - Weekday(PremJanvSuiv, vbMonday) + 1
    Else
        DateSem1Suiv = PremJanvSuiv + 8 - Weekday(PremJanvSuiv, vbMonday)
    End If
    NumSem = 1 + (DateJour - DateSem1) \ 7
    If DateSem1 > DateJour Then
        NumSem = NumSem(PremJanv - 1)
    ElseIf DateJour >= DateSem1Suiv Then
        NumSem = NumSem(PremJanvSuiv)
    End If
End Function

Function CurW(D As Date) As Long ' Roger sur XLD
       CurW = DatePart("WW", D, vbMonday, vbFirstFourDays)
End Function

Function JMH(D As Date) 'Proposé par Jean-Marcel sur XLD
 JMH = DatePart("ww", D, vbMonday, vbFirstFourDays)
End Function