CALCUL AUTOMATIQUE DES N° DE SEMAINE

Public Function Semaine(dat As Date) As Integer
    Dim a As Integer
    a = Int((dat - DateSerial(Year(dat), 1, 1) + _
        ((Weekday(DateSerial(Year(dat), 1, 1)) + 1) _
        Mod 7) - 3) / 7) + 1
    If a = 0 Then
        a = Semaine(DateSerial(Year(dat) - 1, 12, 31))
    ElseIf a = 53 And (Weekday(DateSerial(Year(dat), 12, 31)) - 1) _
        Mod 7 <= 3 Then
        a = 1
    End If
    Semaine = a
End Function

Function WriteWeekAnnee()

Dim NomDuJour(7) As String
Dim StockVal()

LiRef = 3 'La ligne de référence où vont être inscrits la valeur des différentes semaines
Col_Sem_Ref = 6 'Par exemple la semaine de référence se trouve à la colonne N° 6
NB_Colonne_A_Traiter = 34 'Le N° de la dernière colonne à remplir est 30
Lib_Deb_Sem = 4 'N° de la colonne ou commence l'écriture des différentes semaines
Nb_Sem_Before = Col_Sem_Ref - Lib_Deb_Sem 'Nb de semaines avant la semaine de référence

DateActuel = Now
Num_Jour_Actuel = Day(Range("A3").Value) 
Num_Mois_Actuel = Month(Range("A3").Value)
Num_Year_Actuel = Year(Range("A3").Value)
Num_Jour_Sem_Actuel = Weekday(Range("A3").Value, vbUseSystem)

Sem_Ref = Val(Semaine(Range("A3").Value))

If Len(Sem_Ref) = 1 Then
   Range("B2").Value = "0" & Sem_Ref
Else
   Range("B2").Value = Sem_Ref
End If

NbTotSem = 52

LiDeb = Col_Sem_Ref - Nb_Sem_Before

Range(Cells(LiRef, LiDeb), Cells(LiRef, NB_Colonne_A_Traiter)).ClearContents 'On efface les anciennes valeurs

If Sem_Ref Is >= 52 Then
   Sem_Ref = 1
   Num_Year_Actuel = Num_Year_Actuel + 1
Else
   Sem_Ref = Sem_Ref + 1
   Num_Year_Actuel = Num_Year_Actuel
End Select

If Sem_Ref < 10 Then
   Cells(LiRef, Col_Sem_Ref).Value = "0" & Sem_Ref & "/" & Num_Year_Actuel
Else
   Cells(LiRef, Col_Sem_Ref).Value = Sem_Ref & "/" & Num_Year_Actuel
End If

Sem_Actuel = Semaine(CDate(Range("A3").Value))
Sem_Ref = Val(Left(Range("F3").Value, 2))
Annee_Actuel = Val(Year(Range("A3").Value))
Annee_Ref = Val(Right(Cells(LiRef, Col_Sem_Ref).Value, 4))

If Sem_Ref = 1 Then
   Select Case Annee_Ref
   Case Is <> Annee_Actuel
        Range("F3").Offset(0, -1).Value = NbTotSem & "/" & Annee_Ref - 1
        Range("F3").Offset(0, -2).Value = NbTotSem - 1 & "/" & Annee_Ref - 1
   Case Is = Num_Year_Actuel
        Range("F3").Offset(0, -1).Value = NbTotSem & "/" & Annee_Actuel - 1
        Range("F3").Offset(0, -2).Value = NbTotSem - 1 & "/" & Annee_Actuel - 1
   End Select
Else
   If Sem_Ref = 2 Then
      Range("F3").Offset(0, -1).Value = "0" & Sem_Ref - 1 & "/" & Annee_Actuel
      Range("F3").Offset(0, -2).Value = NbTotSem & "/" & Annee_Actuel - 1
   Else
      If Sem_Ref >= 3 And Sem_Ref < 12 Then
         Select Case Sem_Ref
                Case Is <= 10
                     Range("F3").Offset(0, -1).Value = "0" & Sem_Ref - 1 & "/" & Num_Year_Actuel
                     Range("F3").Offset(0, -2).Value = "0" & Sem_Ref - 2 & "/" & Num_Year_Actuel
                Case 11
                     Range("F3").Offset(0, -1).Value = Sem_Ref - 1 & "/" & Num_Year_Actuel
                     Range("F3").Offset(0, -2).Value = "0" & Sem_Ref - 2 & "/" & Num_Year_Actuel
         End Select
      Else
         Range("F3").Offset(0, -1).Value = Sem_Ref - 1 & "/" & Num_Year_Actuel
         Range("F3").Offset(0, -2).Value = Sem_Ref - 2 & "/" & Num_Year_Actuel
      End If
   End If
End If
   
NBIteration = NbTotSem - Left((Cells(LiRef, Col_Sem_Ref).Value), 2)
  
If NBIteration > NB_Colonne_A_Traiter - Col_Sem_Ref Then '24
   NBIteration = NB_Colonne_A_Traiter - Col_Sem_Ref
Else
  If NBIteration = 0 Then
     NBIteration = NB_Colonne_A_Traiter - Col_Sem_Ref
     Sem_Actuel = 0
  Else
     NBIteration = NBIteration
  End If
End If

ReDim StockVal(NBIteration) 'On réalloue de manière dynamique le nbre d'éléments à stocker
  
Val_Sem_Ref = Val(Left((Cells(LiRef, Col_Sem_Ref).Value), 2))
  
If Val_Sem_Ref = NbTotSem Then
   Num_Year_Actuel = Num_Year_Actuel + 1
Else
   Num_Year_Actuel = Num_Year_Actuel
End If

For I = 1 To NBIteration
    Sem_Ref = Sem_Ref + 1
    If Len(Sem_Ref) > 1 Then
       Range("F3").Offset(0, I).Value = Sem_Ref & "/" & Num_Year_Actuel
    Else
       Range("F3").Offset(0, I).Value = "0" & Sem_Ref & "/" & Num_Year_Actuel
    End If
    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 Function

07 décembre 2006 05:09:54 :

Rien de plus sinon que cela fonctionne quelque soit le jour de l'année. Mon nouveau code est bientôt prêt et il ne fait plus que 50 lignes, défit à celui qui arrive à faire la même chose mais en plus court (je suis preneur).