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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 14 026 fois - Téléchargée 24 fois

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

Ajouter un commentaire

Commentaires

Drikce06
Messages postés
2247
Date d'inscription
lundi 29 mai 2006
Statut
Membre
Dernière intervention
29 mai 2008
5 -
Salut et si Num_Year_Actuel = 2007?
Drikce06
Messages postés
2247
Date d'inscription
lundi 29 mai 2006
Statut
Membre
Dernière intervention
29 mai 2008
5 -
Il faudrai que ton code face ça quelque soit l'année! Autant les années passées que les futures!

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.