Du planning en barres à planning texte

Bonjour,

Après 3 jours à sécher sur internet à la recherche d'une formule ou d'un tuto, je me tourne vers vous à la recherche d'un peu d'aide pour résoudre mon problème. Je suis à la recherche d'une formule qui pourrait convertir un planning en barre en planning texte ou inversement.

Je m'explique, j'ai actuellement construit un planning hebdomadaire et individuel en barres pour un salarié 1, cependant, la lecture n'est pas intuitive au premier coup d'œil et peu conduire à des erreurs de lecture de la part de mon salarié et, en conséquence, à des retards pour mal lecture puisque ce planning en barre est tranché par 1/4 d'heure. Je souhaiterai conserver ce planning en barres de mon côté mais ne pas le diffuser aux salariés. À eux, je souhaiterai leur distribuer un planning en texte comme sur l'exemple :

(exemple : lundi 02/08/2021 : 9:00 - 14:45 ... jeudi 07/08/2021 : 9:00 - 12:00 et 13:00 - 18:00) Sur l'exemple je précise avec et sans coupure, car certains salariés n'ont pas de coupure sur certains jours.

Ainsi, en modifiant les horaires de travail sur le planning en barres, les horaires de travail sur le planning texte se modifieraient automatiquement.

Joint, vous trouverez le planning en barres hebdomadaire individuel.

Bonjour à tous,

Une proposition ;

Crdlmt

Salut Guillaume,
Salut Djidji ,

une autre... mais j'ai du changer tes "0,25" par "1"... On verra plus tard si affinités !
Un double clic sur "SALARIE" en colonne [A:A] démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
If Not Intersect(Target, Columns(1)) Is Nothing Then
    Application.ScreenUpdating = False
    Cancel = True
    iRow = Target.Row
    iTCol = Target.Column
    iCol = Cells(1, Columns.Count).End(xlToLeft).Column
    If Target <> "" Then
        On Error Resume Next
        Range("A" & 15).Value = Cells(iRow, 1)
        For x = 0 To 6
            sData = "-"
            iCol1 = Range("D" & iRow + x).Resize(1, iCol).Find(what:=1, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Column
            iCol2 = Range(fctCol(iCol1) & iRow + x).End(xlToRight).Column
            iCol4 = Rows(iRow + x).Find(what:=1, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Column
            If iCol2 < iCol4 Then iCol3 = Range(fctCol(iCol4) & iRow + x).End(xlToLeft).Column
            If iCol1 > 1 Then _
                sData = 4 + Fix(iCol1 / 4) & ":" & Choose((iCol1 Mod 4) + 1, "45", "00", "15", "30") & " - " & _
                    4 + Fix(iCol2 / 4) & ":" & Choose((iCol2 Mod 4) + 1, "00", "15", "30", "45") & _
                    IIf(iCol2 = iCol4, "", " ET " & 4 + Fix(iCol3 / 4) & ":" & Choose((iCol3 Mod 4) + 1, "45", "00", "15", "30") & " - " & _
                    4 + Fix(iCol4 / 4) & ":" & Choose((iCol4 Mod 4) + 1, "00", "15", "30", "45"))
            iCol1 = 0: iCol2 = 0: iCol3 = 0: iCol4 = 0
            Range("D" & 15 + x).Value = Cells(iRow + x, 4)
            Range("F" & 15 + x).Value = sData
        Next
        On Error GoTo 0
        Application.ScreenUpdating = True
    End If
End If
'
End Sub

Un fichier avec la structure exacte, l'affichage souhaité ainsi que le processus de calcul serait le bienvenu.

A+

Bonjour à tous

2 solutions au choix ci-joint :

1. formules
2. plage nommée + PowerQuery (totalement intégré à Excel à partir de 2016, en add on sur 2010 et 2013) à actualiser par Données, Actualiser tout quand le planning change

Salut Guillaume,
Salut les cracks,

une version plus aboutie quoique certainement encore imparfaite quant à tes besoins.
- une liste de validation est créée à la demande pour encoder tes symboles " , 1,+,F,M,R,C,CMT" avec le 1 qui remplace pour l'instant ton 0,25 ;
- une sélection multiple recopie sur la sélection la valeur de la 1ère cellule de cette sélection ;
- le moindre changement est dès lors répercuté dans la feuille 'ConversionTexte".

Par contre, je ne vois pas trop l'intérêt de ton "inversément" stipulé dans ton premier post !

A+

Houlaaa, pas se lever trop tôt non plus...

A+

J'arrive j'arrive, je suis en train d'anonymiser tous mes classeurs pour vous expliquer x)

Bonjour à toutes et tous et merci pour vos nombreuses réponses et votre temps.

Je vais tenter de répondre à tout le monde point par point.

• Déjà vous avez tous visé juste donc merci à toutes et tous pour vos différentes formules qui sont toutes aussi bonnes les unes des autres.

• J'avais choisi 0,25 pour que mon calcul horaire soit plus simple puisque 0,25 = 1/4 d'heure. Mais si c'est possible que 1 = 1/4 d'heure dans le calcul du total d'heure je n'y vois aucun inconvénient.

• Le "inversement" n'avait d'utilité que si barre -> texte était impossible, mais vu que c'est possible, le "inversement" n'a plus d'importance.

• J'ai joint tous mes classeurs pour que vous puissiez voir ce que j'attends

• Sur le planning-test, j'ai ajouté une feuille avec la mise en forme brouillon imprimable que je souhaite distribuer aux salariés.

Salut Guillaume,
Salut l'équipe,

évolution où :
- j'ai remis tes 0.25 ;
- je n'ai pas tenu compte de ton fichier "Planning général".

- il faut ajouter l'année pour pouvoir calculer la date correspondant à la semaine -> [A1] ;
- les dates de la semaine s'inscrivent en [A2] ;
- quand tu changes la semaine, la feuille 'ConversionTexte' s'efface.

Sinon, même fonctionnement...
À tester.

Public Sub Conversion(ByVal iRow%)
'
Dim iTRow%, iYear%, iWeek%, iNb%, iCol%, iCol1%, iCol2%, iCol3%, iCol4%, sData$
'
Cancel = True
Application.ScreenUpdating = False
'
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
With Worksheets("ConversionTexte")
    On Error Resume Next
    iTRow = ((Fix(iRow / 9)) * 15) + IIf(iRow = 3, 1, 0)
    iNb = CInt(Right([NumSem], Len([NumSem]) - 1))
    .Range("A" & iTRow).Value = Cells(iRow, 1)
    .Range("D" & iTRow).Value = "Répartition hebdomadaire"
    .Range("D" & iTRow + 1).Value = "Du  " & fctDateSem(CInt([Annee]), iNb) & "  au  " & DateAdd("d", 6, fctDateSem(CInt([Annee]), iNb))
    .Range("B" & iTRow + 3).Value = "Matin"
    .Range("C" & iTRow + 3).Value = "Après-midi"
    For x = 0 To 6
        .Range("A" & iTRow + 4 + x).Value = Cells(iRow + x, 4)
        .Range("B" & iTRow + 4 + x).Resize(1, 2).Value = "-"
        iCol1 = Range("D" & iRow + x).Resize(1, iCol).Find(what:=0.25, lookat:=xlWhole, LookIn:=xlFormulas, searchdirection:=xlNext).Column
        iCol2 = Range(fctCol(iCol1) & iRow + x).End(xlToRight).Column
        iCol4 = Rows(iRow + x).Find(what:=0.25, lookat:=xlWhole, LookIn:=xlFormulas, searchdirection:=xlPrevious).Column
        If iCol2 < iCol4 Then iCol3 = Range(fctCol(iCol4) & iRow + x).End(xlToLeft).Column
        If iCol1 > 1 Then _
            sData = 4 + Fix(iCol1 / 4) & ":" & Choose((iCol1 Mod 4) + 1, "45", "00", "15", "30") & " - " & _
                4 + Fix(iCol2 / 4) & ":" & Choose((iCol2 Mod 4) + 1, "00", "15", "30", "45") & "/" & _
                IIf(iCol2 = iCol4, "", 4 + Fix(iCol3 / 4) & ":" & Choose((iCol3 Mod 4) + 1, "45", "00", "15", "30") & " - " & _
                4 + Fix(iCol4 / 4) & ":" & Choose((iCol4 Mod 4) + 1, "00", "15", "30", "45")): _
            .Range(IIf(4 + Fix(iCol1 / 4) < 12, "B", "C") & iTRow + 4 + x).Value = Split(sData, "/")(0): _
            If Len(sData) > InStr(sData, "/") Then .Range("C" & iTRow + 4 + x).Value = Split(sData, "/")(1)
        iCol1 = 0: iCol2 = 0: iCol3 = 0: iCol4 = 0
    Next
    On Error GoTo 0
End With
'
Application.ScreenUpdating = True
'
End Sub

A+

Bonjour, et encore merci pour votre réponse et votre temps curulis57.

Bah voilà, c'est presque terminé et exactement ce que j'attendais. Pas de problèmes pour le planning G, je m'occuperai de faire les réglages.
J'ai juste deux dernières petites questions:

• J'ai fais un test sur votre planning et quand je valide des horaires sur 12h45 - 17h en début de planning, le planning texte me valide 13h45 - 17h automatiquement, est-ce normal en raison de la séparation matin/après-midi ou est-ce modifiable ?

• La dernière concerne la mise en forme. J'ai l'habitude de travailler en drag-n drop pour la formation du planning en barre et valider "recopier la valeur de la cellule sans la mise en forme" à chaque fois afin de garder un planning lisible grâce aux bordures. Est-ce également possible ? Ou bien existe-t-il un raccourci clavier le permettant. Après test sur votre travail, l'option de recopier la valeur sans la mise en forme ne m'est pas proposée.

Encore merci à toutes et tous et il s'agira de mes dernières questions puisque le problème de base est résolu. (je n'oublierai pas le petit tick !)

Salut Guillaume,
Salut l'équipe,

le problème des heures '45 est réglé : une histoire de MODULO... Jamais été fort en math !
Je regarde ce soir pour le drag'n'drop, sans garantie...

A+

Merci et encore merci, je vais chercher de mon côté même si je ne serai pas de très bonne utilité .

Salut Guillaume,

j'ai trouvé un fonctionnement interne à Excel correspondant à ton drag'n'drop mais, vu le fonctionnement développé dans ton programme, il faudra passer par des trucs et astuces pour opérer.

Processus général : tu sélectionnes les cellules à déplacer puis tu déplaces le bloc avec le bouton DROIT de la souris.

Quand tu lâches, un menu contextuel s'ouvre qui te propose :
- l'option "Placer ici", la source mais sa mise en forme itou sont déplacées, ce qui peut évidemment poser problème (bordures et/ou dépassement des limites du bloc-semaine) ;
- l'option "Copier les valeurs seules" qui est mieux mais ne laisse la source en place.

Bref, il y a de la matière à creuser... ce qui me va très bien !

Donc, je vais creuser et te reviendrai quand j'aurai dénicher le bon truc.

A+

Salut Guillaume,

il me semble avoir trouvé le moyen de concilier les divers éléments de ton programme.

Étant donner qu'une multi-sélection classique voit la 1ère cellule de cette sélection se copier sur toutes les autres, lorsque tu veux effectuer une copie ou un déplacement d'un horaire, il faut, comme première étape OBLIGATOIRE, faire un clic DROIT sur la cellule qui sera la 1ère cellule de la sélection.
Témoin de cette action, un cadre rouge cernera cette cellule. Tu peux maintenant effectuer la sélection de cellules sans l'effet classique décrit ci-dessus.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%, iTRow%, iCol%
'
Application.EnableEvents = False
'
iRow = Target.Row
iCol = Target.Column
'
If iRow > 2 And iCol > 4 And Range("D" & iRow).Value <> "" And Cells(1, iCol) <> "" Then _
    If Selection.Count = 1 Then _
        Cancel = True: _
        [B1] = Target.Row: _
        Target.Font.Italic = True: _
        Target.BorderAround Weight:=xlMedium, Color:=RGB(255, 0, 0)
'
Application.EnableEvents = True
'
End Sub

Ensuite, pour :
- DÉPLACER la sélection, cibler la bordure de la sélection (le pointeur de souris se transforme en croix) et... drag'n'drop ;
- COPIER (ou déplacer aussi) la sélection ailleurs, cibler la bordure de la sélection (le pointeur de souris se transforme en croix), et déplacer la sélection avec le bouton DROIT de la souris.
Quand tu lâches le bouton, un menu contextuel s'affiche :
* choisir "Copier ici" pour copier ;
* choisir "Placer ici" pour déplacer.

Avec ces changements, il faut maintenant DOUBLE-CLIQUER une cellule pour créer la liste de validation de choix du symbole-horaire approprié.

A+

Salut Curulis57

C'est parfait, tout est clair et rodé, merci beaucoup pour votre aide et votre temps ! Bonne continuation à toutes et tous !