VBA EXCEL - ATTRIBUÉ EN FONCTION DE L'ANNÉE UN N° DE SEMAINE DIFFÉRENTS PAR CELLULES

Function Semaine(ddate As Date)
  Semaine = Format(ddate, "ww", , vbFirstFourDays)
End Function

Function Initialise_Semaine()

Dim NomDuJour(7) As String
Dim StockVal()
Nb_Colonne_A_Traiter = 30

DateActuel = Now
Num_Jour_Actuel = Day(DateActuel)
Num_Mois_Actuel = Month(DateActuel)
Num_Year_Actuel = Year(DateActuel)
Num_Jour_Sem_Actuel = Weekday(DateActuel, vbUseSystem)


Select Case Num_Year_Actuel
  Case 2006
       NbTotSem = 52
  Case 2007
       NbTotSem = 53
  Case 2008
       NbTotSem = 52
  Case 2009
       NbTotSem = 52
End Select

Select Case Num_Jour_Sem_Actuel
   Case 1
     NomDuJour(1) = "Lundi"
   Case 2
     NomDuJour(2) = "Mardi"
   Case 3
     NomDuJour(3) = "Mercredi"
   Case 4
     NomDuJour(4) = "Jeudi"
   Case 5
     NomDuJour(5) = "Vendredi"
   Case 6
     NomDuJour(6) = "Samedi"
   Case 7
     NomDuJour(7) = "Dimanche"
End Select


Range("F3").Value = Semaine(Range("A3").Value) & "/" & Num_Year_Actuel
Sem_Actuel = Left(Range("F3").Value, 2)
Range("F3").Offset(0, -1).Value = Sem_Actuel - 1 & "/" & Num_Year_Actuel
Range("F3").Offset(0, -2).Value = Sem_Actuel - 2 & "/" & Num_Year_Actuel

If Num_Year_Actuel = 2006 Then
   
   NBIteration = NbTotSem - Left(Range("F3").Value, 2)
   ReDim StockVal(NBIteration) 'On réalloue de manière dynamique le nbre d'éléments à stocker
   
   For I = 1 To NBIteration
       Sem_Actuel = Left(Range("F3").Value, 2) + I
       Range("F3").Offset(0, I).Value = Sem_Actuel & "/" & Num_Year_Actuel
       StockVal(1) = Range("F3").Offset(0, I).Value
   Next I
   
   Val_Find = StockVal(1)
   ValCelSem = Cells.Find(Val_Find, , , , xlByColumns, xlPrevious).Column
   adCelSem = Cells.Find(Val_Find, , , , xlByColumns, xlPrevious).Address
   NewYear = Right(Range(adCelSem), 4) + 1
   NBIteration = Nb_Colonne_A_Traiter - ValCelSem
   
   For I = 1 To NBIteration
       If Len(I) = 1 Then
          Sem_Actuel = I
          Range(adCelSem).Offset(0, I).Value = "0" & Sem_Actuel & "/" & NewYear
       Else
          Sem_Actuel = I
          Range(adCelSem).Offset(0, I).Value = Sem_Actuel & "/" & NewYear
       End If
   Next I
   
End If

End Function