Microsoft 365 Planning perpétuel verticale uniquement jours ouvrés (du lundi au vendredi)

[TAL]

Bonjour à tous,

Après de nombreuses recherche, je ne parviens pas à trouver de réponse adapté à mon format de planning. Celui ce construit en verticale
Je voudrais faire un planning uniquement avec les jours ouvrés, du lundi au vendredi.
J'essaie de trouver une formule pour les "fin de mois" mais systématiquement il me mets les jours du mois suivant.
Je cherche également une formule VBA qui permettrait de cacher les lignes non concernés par le mois.

Je vous joins un extrait du planning

Dans l'attente de vous lire
Bien à vous

 

[TAL]

Re bonjour,

La moindre des choses est de demander, svp.
Désolée, en relisant mon message, je me suis aperçu que je ne l'avais pas demandé.

Si quelqu'un veut bien m'aider, s'il vous plait
Merci à vous

 

[job75]

Bonsoir TAL,

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

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Mois,Année]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim deb As Variant, fin&, dat&, fer As Range, lig&
Rows("5:" & Rows.Count).Delete 'RAZ
deb = [Mois] & "/" & [Année]
If Not IsDate(deb) Then Exit Sub
deb = CLng(CDate(deb))
fin = deb + 364
If Day(fin + 1) > 1 Then fin = fin + 1 'année bissextile
Set fer = [ferie]
lig = 5
For dat = deb To fin '1 an
    If lig > 5 And Day(dat) = 1 Then
        Rows("2:4").Copy Rows(lig + 1)
        Cells(lig + 1, 3) = dat
        lig = lig + 4
    End If
    If Weekday(dat, 2) < 6 And Application.CountIf(fer, dat) = 0 Then
        Cells(lig, 1) = dat
        Cells(lig, 2) = dat
        Cells(lig, 1).Resize(, 10).Borders.Weight = xlThin 'bordures
        lig = lig + 1
    End If
Next
End Sub

Je n'ai pas suivi tout ce que vous vouliez, il faut faire des choses simples.

A+

 

[Jacky67]

Bonjour,
Hello Gérard, content de te revoir parmi nous
Je propose un calendrier plus simple

** Pj erronée, Pj supprimée

 

[TAL]

Bonjour,

Merci à tous les deux pour vos réponses.

@ Gérard, je n'arrive pas à activer la macro, Microsoft me bloque

@jacky
Il est certain que le calendrier et plus simple, mais j'ai besoin de séparer les mois.

Si toutefois je n'arriverai pas débloquer la macro, serait-il possible d'avoir une formule qui me permettrait d'avoir le dernier jour de la semaine pour chaque mois, que celui-ci ne déborde pas sur le mois suivant, je masquerai manuellement, s'il le faut.

Merci à tous les deux
Je vous souhaite une bonne soirée

 

[job75]

@ Gérard, je n'arrive pas à activer la macro, Microsoft me bloque
Regarde la pièce jointe 1153147

Clic droit sur l'icône => Propriétés => activer la case "Débloquer".

Edit : salut Jacky67

 

[TAL]

Clic droit sur l'icône => Propriétés => activer la case "Débloquer".

SUPER MERCI BEAUCOUP
C'est parfait

Encore une question, je dois l'adapter à mon planning, j'avais fait une petite extraction.
Je voudrais ajouter en colonne A le numéro de semaine, désolée, je n'y avais pas pensé avant, que dois-je faire.
J'ai réussir à rallonger pour les bordures mais je n'arrive pas à trouver le paramètres pour déplacer les dates en colonne B.

Bonne soirée

 

[TAL]

SUPER MERCI BEAUCOUP
C'est parfait

Encore une question, je dois l'adapter à mon planning, j'avais fait une petite extraction.
Je voudrais ajouter en colonne A le numéro de semaine, désolée, je n'y avais pas pensé avant, que dois-je faire.
J'ai réussir à rallonger pour les bordures mais je n'arrive pas à trouver le paramètres pour déplacer les dates en colonne B.

Bonne soirée

Incroyable !! J'ai trouvé pour déplacer les dates d'une colonne.
Il me manque plus que le numéro de semaine et si toutefois cela n'était pas abuser, pouvez vous me dire comment mettre les mois en entier ex : précédemment oct-22 en OCTOBRE 2022

Encore merci

 

[job75]

Bonjour TAL, Jacky67, le forum,

Voyez ce fichier (2) et la macro adaptée :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Mois,Année]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim deb As Variant, fin&, dat&, fer As Range, lig&
Rows("5:" & Rows.Count).Delete 'RAZ
deb = [Mois] & "/" & [Année]
If Not IsDate(deb) Then Exit Sub
deb = CLng(CDate(deb))
fin = deb + 364
If Day(fin + 1) > 1 Then fin = fin + 1 'année bissextile
Set fer = [ferie]
lig = 5
For dat = deb To fin '1 an
    If lig > 5 And Day(dat) = 1 Then
        Rows("2:4").Copy Rows(lig + 1)
        Cells(lig + 1, 4) = UCase(Format(dat, "mmmm yyyy"))
        lig = lig + 4
    End If
    If Weekday(dat, 2) < 6 And Application.CountIf(fer, dat) = 0 Then
        Cells(lig, 1) = Application.IsoWeekNum(dat)
        Cells(lig, 2) = dat
        Cells(lig, 3) = dat
        Cells(lig, 1).Resize(, 11).Borders.Weight = xlThin 'bordures
        lig = lig + 1
    End If
Next
End Sub

Le numéro de semaine ISO est en colonne A.

A+

 

[Jacky67]

Bonjour,

Merci à tous les deux pour vos réponses.

@ Gérard, je n'arrive pas à activer la macro, Microsoft me bloque
Regarde la pièce jointe 1153147

@jacky
Il est certain que le calendrier et plus simple, mais j'ai besoin de séparer les mois.

Si toutefois je n'arriverai pas débloquer la macro, serait-il possible d'avoir une formule qui me permettrait d'avoir le dernier jour de la semaine pour chaque mois, que celui-ci ne déborde pas sur le mois suivant, je masquerai manuellement, s'il le faut.

Merci à tous les deux
Je vous souhaite une bonne soirée

Bonjour à tous,
Une version qui permet de garder les données sur toute l'année.

 

[VIARD]

Bonjours @job75 ,@Jacky67 , @TAL et à tous

Je propose à partir du code de Job une petite amélioration
pour voir l'alternance des semaines.

For dat = deb To fin '1 an
    If lig > 5 And Day(dat) = 1 Then
        Rows("2:4").Copy Rows(lig + 1)
        Cells(lig + 1, 4) = UCase(Format(dat, "mmmm yyyy"))
        lig = lig + 4
    End If
    If Weekday(dat, 2) < 6 And Application.CountIf(fer, dat) = 0 Then
        If Application.IsoWeekNum(dat) Mod 2 = 0 Then 'une semaine sur deux
            Cells(lig, 1).Interior.ColorIndex = 4
        End If
        Cells(lig, 1) = Application.IsoWeekNum(dat)
        Cells(lig, 2) = dat
        Cells(lig, 3) = dat
        Cells(lig, 1).Resize(, 11).Borders.Weight = xlThin 'bordures
        lig = lig + 1
    End If
Next

Salutations à tous
Bonne santé Job
Cordialement
Jean-Paul

 

[TAL]

Bonjour à tous,

Merci beaucoup de votre aide.
@job75 Un grand Merci, cela fonctionne parfaitement bien.

@Jacky67 C'est une excellente idée. Cela va m'aider sur un autre tableau, merci beaucoup

@VIARD Je n'ai pas encore testé. Je regarderai quel impact cela peut avoir sur mon tableau. Merci beaucoup

Un grand merci !!!!!!!