Vba excel - attribué en fonction de l'année un n° de semaine différents par cellules

Commenter

Contenu du snippet

Permet de créer sur une feuille excel un N° de semaine par cellule dépendant de l'année en cours.
Si le n° de la semaine incrémenté est égale au nbre total de semaine de l'année en cours, alors on
repart à la semaine N° 1 en incréméntant l'année en cours jusqu'à remplir le nombre de cellules choisies
au départ.

Source / Exemple : 


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

Conclusion :


Toute suggestion, sera la bienvenue.

Merci d'avance de vos remarques

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (fpetit25)