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

Etoto

Etoto

XLDnaute Barbatruc
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. ;)
 

Pièces jointes

  • ClasEtoto(1).xlsm
    28.7 KB · Affichages: 6
Solution
Dranreb
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())"...
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
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)"
 
Vote positif 2 Vote négatif
Etoto

Etoto

XLDnaute Barbatruc
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)"
Cliquez pour agrandir...
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 o_O.

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
 

Pièces jointes

  • ClasEtoto(1) - Copie.xlsm
    30.6 KB · Affichages: 2
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
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.
 

Pièces jointes

  • DateAnSemJs.xlsm
    66.2 KB · Affichages: 1
Vote positif 1 Vote négatif
Etoto

Etoto

XLDnaute Barbatruc
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.
Cliquez pour agrandir...
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. :confused:
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
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
 
Vote positif 1 Vote négatif
Solution
Etoto

Etoto

XLDnaute Barbatruc
Hello,
vgendron à dit:
Hello Bernard

une autre proposition par macro pour générer le calendrier
Cliquez pour agrandir...
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
Cliquez pour agrandir...
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
Cliquez pour agrandir...
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.
 

Pièces jointes

  • ClasDranreb.xlsm
    29.8 KB · Affichages: 2
Vote positif 0 Vote négatif

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
E
  • Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
925
fanch55
fanch55
GADENSEB
  • Question
Microsoft 365 Simplification de code
Réponses
1
Affichages
1 K
GADENSEB
GADENSEB
C
  • Question
XL 2016 VBA - Insertion de lignes automatique sous condition et copier formats et formules dans la nouvelle ligne
Réponses
10
Affichages
1 K
clochette
C
JBARBE
  • Question
Un bon livre pour amélioration code VBA adressé à mapomme et autres personnes trés compétentes
Réponses
0
Affichages
1 K
JBARBE
JBARBE
N
  • Question
Booster une macro
Réponses
5
Affichages
3 K
Staple1600
Staple1600
iStarOSX
  • Question
Simplification de code VBA
Réponses
8
Affichages
2 K
iStarOSX
iStarOSX
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
35 K
MichelXld
M
M
[REF] Wiki 2 de MichelXld (Ce qui touche aux UserForm)
Réponses
0
Affichages
116 K
MichelXld
M

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 62 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 059
Messages
2 115 817
Membres
112 553
dernier inscrit
carlos33