Microsoft 365 VBA Insertion du numéro de semaine de manière dynamique

Etoto · Hier à 08:46

Hello la team,

Je reviens avec mon fichier de planning d'absence auquel @Dranreb a déjà pu beaucoup m'aider. C'est un planning dynamique, si on change l'année en A1, tout le calendrier se régénère grâce à des formules et des codes VBA.

Malheureusement on me demande maintenant de mettre les numéros de semaines en gras sur la ligne 4, là où se situe déjà les dates. Il faudrait insérer automatiquement le numéro de semaine au milieu des semaines, par exemple, la première occurrence pour 2025 serait C4 avec un 1. Voici le code d'insertions des formules fait par @Dranreb (Merci ) :

VB:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$A$1" Then Exit Sub
   Application.EnableEvents = False
   [B4].FormulaR1C1 = "=DATE(RIGHT(R1C1,4),1,1)"
   [C4:JC4].FormulaR1C1 = "=RC[-1]+(WEEKDAY(RC[-1],2)=5)*2+1"
   With [B3:JC3]
      .FormulaR1C1 = "=IF(MONTH(R4C)<>MONTH(R4C[-1]),TEXT(R4C,""mmmm""),NA())"
      [B3].FormulaR1C1 = "=TEXT(R4C,""mmmm"")"
      .SpecialCells(xlCellTypeFormulas, 16).ClearContents
      .HorizontalAlignment = xlCenterAcrossSelection
      With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .Weight = xlMedium: End With
      End With
   [B5:JC5].FormulaR1C1 = "=MID(""LuMaMeJeVe"",2*WEEKDAY(R[-1]C,2)-1,2)"
   Application.EnableEvents = True
   End Sub

Le problème est que, comme vous voyez, la ligne 5 s'alimente sur la ligne 4 pour créer les noms des jours, si on remplace des cellules en ligne 4, ça va créer des problèmes. Avez-vous une solution où sommes nous arrivés au limites et il faudrait mieux créer une nouvelle ligne ?

Je reste à dispo si besoin d'infos.

Merci d'avance à vous tous.

Dranreb · Hier à 11:33

Je pense qu'on peut faire comme pour le mois :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$A$1" Then Exit Sub
   Application.EnableEvents = False
   [B5].FormulaR1C1 = "=DATE(R1C1,1,1)"
   [C5:JC5].FormulaR1C1 = "=RC[-1]+(WEEKDAY(RC[-1],2)=5)*2+1"
   With [B3:JC3]
      .FormulaR1C1 = "=IF(MONTH(R5C)<>MONTH(R5C[-1]),TEXT(R5C,""mmmm""),NA())"
      [B3].FormulaR1C1 = "=TEXT(R5C,""mmmm"")"
      .SpecialCells(xlCellTypeFormulas, 16).ClearContents
      .HorizontalAlignment = xlCenterAcrossSelection
      With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .Weight = xlMedium: End With
      End With
   With [B4:JC4]
     .FormulaR1C1 = "=IF(WEEKDAY(R5C,2)=1,ISOWEEKNUM(R5C),NA())"...

vgendron · Hier à 10:07

Bonjour

bah déjà, tu peux utiliser la meme ligne 4 pour afficher le jour au format "jjj j" (et tu supprimes evidemment ta MFC)

et sur la ligne 5, tu calcules le numéro de la semaine avec no.semaine.iso

sinon, en A1, tu mets ce format personalisé de cellule
"Tableau des absences "0

ce qui te permet de n'avoir à taper QUE l'année en A1
et en B4 la formule devient "=date(A1;1;1)"

Etoto · Hier à 10:31

vgendron à dit:
Bonjour

bah déjà, tu peux utiliser la meme ligne 4 pour afficher le jour au format "jjj j" (et tu supprimes evidemment ta MFC)

et sur la ligne 5, tu calcules le numéro de la semaine avec no.semaine.iso

sinon, en A1, tu mets ce format personalisé de cellule
"Tableau des absences "0

ce qui te permet de n'avoir à taper QUE l'année en A1
et en B4 la formule devient "=date(A1;1;1)"

Hello,

J'ai suivi tes suggestions, tu sais maintenant s'il y a un moyen avec ce fichier de pouvoir automatiquement et dynamiquement placer le numéro de semaine sur la ligne 4 ? J'ai déplacé les cellules "jjj j" sur la ligne 5 du coup ?

Je me rend compte que je me complique trop la vie avec certaines formules parfois grâce à vous .

Voici le fichier avec tes suggestions et j'ai changé le code :

VB:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$A$1" Then Exit Sub
   Application.EnableEvents = False
   [B5].FormulaR1C1 = "=DATE(R1C1,1,1)"
   [C5:JC5].FormulaR1C1 = "=RC[-1]+(WEEKDAY(RC[-1],2)=5)*2+1"
   With [B3:JC3]
      .FormulaR1C1 = "=IF(MONTH(R5C)<>MONTH(R5C[-1]),TEXT(R5C,""mmmm""),NA())"
      [B3].FormulaR1C1 = "=TEXT(R5C,""mmmm"")"
      .SpecialCells(xlCellTypeFormulas, 16).ClearContents
      .HorizontalAlignment = xlCenterAcrossSelection
      With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .Weight = xlMedium: End With
      End With
   Application.EnableEvents = True
   End Sub

Dranreb · Hier à 11:00

Bonjour.
Attention, on risque de vous dire après qu'on voudrait que la 1ère colonne soit toujours le lundi de la 1ère semaine de l'année …
D'un autre coté ça pourrait simplifier certaines choses …
Je joins un classeur de réflexion, et surtout de fonctions perso utiles mais dont il n'est pas trop difficile de se passer aux prix de formules un peu plus longues.

Etoto · Hier à 11:03

Dranreb à dit:
Bonjour.
Attention, on risque de vous dire après qu'on voudrait que la 1ère colonne soit toujours le lundi de la 1ère semaine de l'année …
D'un autre coté ça pourrait simplifier certaines choses …
Je joins un classeur de réflexion, et surtout de fonctions perso utiles mais dont il n'est pas trop difficile de se passer aux prix de formules un peu plus longues.

Sympa tes fonctions VBA, décidément, ça donne bien.

Si cela peut te rassurer, ils ne vont pas me demander cela, je mettais assuré d'avoir toutes les infos quand je t'ai fait la première demande, malheureusement j'avais oublié le cas du numéro de semaine.

vgendron · Hier à 11:32

Hello Bernard

une autre proposition par macro pour générer le calendrier

Dranreb · Hier à 11:33

Je pense qu'on peut faire comme pour le mois :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$A$1" Then Exit Sub
   Application.EnableEvents = False
   [B5].FormulaR1C1 = "=DATE(R1C1,1,1)"
   [C5:JC5].FormulaR1C1 = "=RC[-1]+(WEEKDAY(RC[-1],2)=5)*2+1"
   With [B3:JC3]
      .FormulaR1C1 = "=IF(MONTH(R5C)<>MONTH(R5C[-1]),TEXT(R5C,""mmmm""),NA())"
      [B3].FormulaR1C1 = "=TEXT(R5C,""mmmm"")"
      .SpecialCells(xlCellTypeFormulas, 16).ClearContents
      .HorizontalAlignment = xlCenterAcrossSelection
      With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .Weight = xlMedium: End With
      End With
   With [B4:JC4]
     .FormulaR1C1 = "=IF(WEEKDAY(R5C,2)=1,ISOWEEKNUM(R5C),NA())"
      [B4].FormulaR1C1 = "=ISOWEEKNUM(R5C)"
      .SpecialCells(xlCellTypeFormulas, 16).ClearContents
      .HorizontalAlignment = xlCenterAcrossSelection
      With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .Weight = xlThin: End With
      End With
   Application.EnableEvents = True
   End Sub

Etoto · Hier à 11:35

Merci messieurs, je vous redis après ma pause dîner quand je serai de retour sur mon PC, merci pour votre aide à vous deux.

fanfan38 · Hier à 11:46

Bonjour
Ci joint ma solution... par contre je coince sur la formule du mois (que je ne connais pas)

A+ François

Etoto · Hier à 12:30

Hello,

vgendron à dit:
Hello Bernard

une autre proposition par macro pour générer le calendrier

Merci beaucoup, ton fichier est super mais il ne préserve pas les bordures des en-tête, par contre il a un coté extrêmement dynamique, merci beaucoup.

Je le garde en stock.

Dranreb à dit:

Je pense qu'on peut faire comme pour le mois :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$A$1" Then Exit Sub
   Application.EnableEvents = False
   [B5].FormulaR1C1 = "=DATE(R1C1,1,1)"
   [C5:JC5].FormulaR1C1 = "=RC[-1]+(WEEKDAY(RC[-1],2)=5)*2+1"
   With [B3:JC3]
      .FormulaR1C1 = "=IF(MONTH(R5C)<>MONTH(R5C[-1]),TEXT(R5C,""mmmm""),NA())"
      [B3].FormulaR1C1 = "=TEXT(R5C,""mmmm"")"
      .SpecialCells(xlCellTypeFormulas, 16).ClearContents
      .HorizontalAlignment = xlCenterAcrossSelection
      With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .Weight = xlMedium: End With
      End With
   With [B4:JC4]
     .FormulaR1C1 = "=IF(WEEKDAY(R5C,2)=1,ISOWEEKNUM(R5C),NA())"
      [B4].FormulaR1C1 = "=ISOWEEKNUM(R5C)"
      .SpecialCells(xlCellTypeFormulas, 16).ClearContents
      .HorizontalAlignment = xlCenterAcrossSelection
      With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .Weight = xlThin: End With
      End With
   Application.EnableEvents = True
   End Sub

Ton code est plus que parfait, j'ai pu l'incorporer à mon fichier et il fonctionne très bien.

fanfan38 à dit:
Bonjour
Ci joint ma solution... par contre je coince sur la formule du mois (que je ne connais pas)

A+ François

Ta solution par formule est très intéressante, plus efficace que celle que j'avais tout au départ, je vais garder les formules en cas de besoin, merci beaucoup.

Merci beaucoup à vous trois pour m'avoir donné la solution.

PS : Je joins le fichier final avec le code de @Dranreb.

vgendron · Hier à 12:31

Etoto à dit:
Merci beaucoup, ton fichier est super mais il ne préserve pas les bordures des en-tête, par contre il a un coté extrêmement dynamique, merci beaucoup.

il suffit de modifier le code pour remettre ces bordures...
j'ai mis des commentaires dans le code pour que justement tu vois comment on fait

Etoto · Hier à 12:33

vgendron à dit:
il suffit de modifier le code pour remettre ces bordures...
j'ai mis des commentaires dans le code pour que justement tu vois comment on fait

Super, je vais pouvoir regarder également, c’est sympa de mettre des commentaires pour les moins experts du VBA comme moi

Microsoft 365 VBA Insertion du numéro de semaine de manière dynamique

Etoto

XLDnaute Barbatruc

Pièces jointes

Dranreb

vgendron

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

Etoto

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

fanfan38

XLDnaute Barbatruc

Pièces jointes

Etoto

XLDnaute Barbatruc

Pièces jointes

vgendron

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

Discussions similaires