Microsoft 365 insérer automatiquement une colonne après chaque semaine

[aceathena]

Bonjour,
Je souhaiterais créer un planning mensuel automatique. En saisissants le premier jour du mois toutes les autres dates s'affiche quelque soit le mois.
Jusque la pas de soucis
Mais je souhaiterais que les jours qui s'affichent soit du lundi au samedi et qu'a la place du dimanche, s’insère automatiquement une cellule commentaire.
La je suis perdue.
Pouvez-vous m'aider?

 

[vgendron]

Hello
un essai par formule
en A1 ta première date
en B1, une formule
en C1 une seconde formule (qui ne pourrait pas fonctionner en B1) et tu la tires vers la droite

 

[aceathena]

super merci pour la proposition.
J'ai juste un souci concernant les dates car elles ne correspondent pas.
La formule fonctionne pour la première semaine du mois mais arriver au premier dimanche (ou cellule vide), les dates ne suivent pas

 

[JHA]

Bonjour à tous,

A essayer avec ce que je comprends.

JHA

 

[Hasco]

Bonjour,

Pour le fun et sur la base du fichier de l'ami @JHA que je salue bien bas, autre formule pour excel 365 et +

=LET(leMois;SEQUENCE(1;FIN.MOIS(B1;0)-B1+1;B1);leMois*(JOURSEM(leMois)<>1))

Avec le format personnalisé : jj/mm;;""

Cordialement

 

[job75]

Bonsoir aceathena, vgendron, JHA, Hasco,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
With [A7]
    If Intersect(Target, .Offset(1)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    .Offset(1).Select
    If Not IsDate(.Offset(1)) Then .EntireRow.Resize(2).ClearContents: GoTo 1
    .Offset(1) = DateSerial(Year(.Offset(1)), Month(.Offset(1)), 1) '1er jour du mois
    .Offset(1, 1).Resize(, 30) = "=IFERROR(IF(MONTH(RC[-1]+1)=MONTH(RC[-1]),RC[-1]+1,""""),"""")"
    .Resize(, 31) = "=IFERROR(IF(WEEKDAY(R[1]C)=1,""#N/A"",TEXT(R[1]C,""jjjj"")),"""")" 'jjjj pour version française
    .Resize(2, 31) = .Resize(2, 31).Value 'supprime les formules
    .Resize(, 31).SpecialCells(xlCellTypeConstants, 16).Offset(1) = ""
    .Resize(, 31).Replace "#N/A", "Commentaire"
    .Resize(2, 31).Columns.AutoFit 'ajuste les largeurs
1   Application.EnableEvents = True 'réactive les évènements
End With
With UsedRange: End With 'actualise la barre de défilement horizontale
End Sub

Modifiez ou validez la cellule A8.

Edit : ajouté l'avant-dernière ligne.

A+

 

[job75]

A priori les solutions par formules ne conviennent pas puisqu'il faut entrer les commentaires manuellement.

 

[JHA]

Bonjour à tous,

Bonjour @job75 à qui je souhaite un bon rétablissement.

Tu as tout à fait raison mais ma nullité en VBA ne me permet pas de réaliser cet excellent code que tu as proposé .

Pour ma part, je fais donc un copier/collage spécial/valeur sur une autre feuille et je masque la feuille avec les formules .

JHA

 

[job75]

Bonjour le fil, le forum,

Avec le fichier précédent, si l'on entre 01/05/2022 en A8, A7 contient "Commentaire" car c'est un dimanche.

Mais on ne peut plus rien entrer ensuite en A8.

Pour y remédier utilisez ce fichier (2) avec :

Private Sub Worksheet_Change(ByVal Target As Range)
With [A7]
    If Intersect(Target, .Offset(1)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False ' and not isdate(.offse les évènements
    .Offset(1).Select
    If Not IsDate(.Offset(1)) Then
        If .Value <> "Commentaire" Then .EntireRow.Resize(2).ClearContents
        GoTo 1
    End If
    .Offset(1) = DateSerial(Year(.Offset(1)), Month(.Offset(1)), 1) '1er jour du mois
    .Offset(1, 1).Resize(, 30) = "=IFERROR(IF(MONTH(RC[-1]+1)=MONTH(RC[-1]),RC[-1]+1,""""),"""")"
    .Resize(, 31) = "=IFERROR(IF(WEEKDAY(R[1]C)=1,""#N/A"",TEXT(R[1]C,""jjjj"")),"""")" 'jjjj pour version française
    .Resize(2, 31) = .Resize(2, 31).Value 'supprime les formules
    .Resize(, 31).SpecialCells(xlCellTypeConstants, 16).Offset(1) = ""
    .Resize(, 31).Replace "#N/A", "Commentaire"
    .Resize(2, 31).Columns.AutoFit 'ajuste les largeurs
1   Application.EnableEvents = True 'réactive les évènements
End With
With UsedRange: End With 'actualise la barre de défilement horizontale
End Sub

A+