Transmettre infos d'un planning à une feuille du jour

Ok excuse-moi en effet mal lu j'avais séparé les deux, maintenant quand je clique sur l'une un l'autre j'ai cela :

image

Sachant que pour la feuille du jour j'ai bien mis une date en 01/07/25, et pour feuille du mois j'ai mis 07/25. Dans les deux cas le message d'erreur pointe sur cette ligne : je dois mettre jj/mm/aa au lieu de j/m/a ?

Ok en fait maintenant que je réouvre le .xlsm, il me rebloque avec les macros.

Je contacte mon support voir ce que je peux faire histoire qu'on avance car ca devient pénible ce blocage.

re,

je t'ai mis un code adapté pour gérer le problème que tu rencontres. Refais toute la procédure que j'ai expliquée jeudi à 15:01 mais avec ce code-ci.

Pour éviter le problème de macros non autorisées (tu peux essayer de sauvegarder le document au format .xls (excel 97-2003 workbook) et voir ce que cela donne.)

Sub feuilledujour()
    Application.StatusBar = ""
    Application.ScreenUpdating = False
    Do Until ddjok(ddj)
        ddj = InputBox("date pour laquelle établir la feuille du jour (format jj/mm/aa)")
        If ddj = "" Then Exit Sub
        If ddjok(ddj) Then Exit Do
        MsgBox ddj & " Date incorrecte"
    Loop
    Application.StatusBar = "en cours"
    genfeuil ddj 'génère planning du jour
    MsgBox "génération du planning terminée"
    Application.StatusBar = ""
End Sub

Sub feuillesdumois()
    Application.StatusBar = ""
    Do Until moisok(ddj)
        ddj = InputBox("mois pour lequel établir les feuilles du jour (format mm/aa)")
        If ddj = "" Then Exit Sub
        If moisok(ddj) Then Exit Do
        MsgBox ddj & " mois incorrect"
    Loop
        ddjvt = Split(ddj, "/")
    ddj = DateSerial(ddjvt(1), ddjvt(0), 1)
    For i = ddj To Application.WorksheetFunction.EoMonth(ddj, 0)
      Application.StatusBar = "génération feuille pour le " & Format(i, "dd/mm/yyyy")
      Application.ScreenUpdating = False
      genfeuil i 'génére le planning pour le jour i
    Next i
    Application.StatusBar = ""
End Sub
Sub genfeuil(ddj)
' génération d'une feuille planning cuisine pour la date ddj
    ddjvt = Split(ddj, "/")
    ddj = DateSerial(ddjvt(2), ddjvt(1), ddjvt(0))
    annee = Format(ddj, "yyyy")
    listemois = Split(",Janvier,Février,Mars,Avril,Mai,Juin,Juillet,Août,Septembre,Octobre,Novembre,Décembre", ",")
    mois = listemois(ddjvt(1)) & " " & annee        'feuille dans le classeur
    Set twb = ThisWorkbook
    On Error Resume Next
    Application.DisplayAlerts = False
    twb.Sheets(Format(ddj, "dd.mm.yy")).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    twb.Sheets("modèle").Visible = True
    twb.Sheets("modèle").Copy after:=twb.Sheets(twb.Sheets.Count)
    twb.Sheets("modèle").Visible = False
    Set wsp = twb.ActiveSheet
    wsp.Name = Format(ddj, "dd.mm.yy")
    wsp.Range("D4") = Format(ddj, "dddd, d mmmm yyyy")
    chemin = twb.Sheets("instructions").Range("J4") & "\"

    ' fichier 1-planning-année-self.xls
    nf = Replace("1-planning-année-self.xls", "année", annee)
    Set wb = Workbooks.Open(chemin & nf)
    If wb Is Nothing Then MsgBox "fichier " & chemin & nf & " non trouvé": Exit Sub
    Set ws = wb.Sheets(mois)        'la feuille dans le classeur
    Set re = Nothing
    Set re = ws.Range("A1:A100").Find("HORAIRE", lookat:=xlPart, MatchCase:=False)
    If re Is Nothing Then MsgBox "la feuille " & ws.Name & " du fichier " & wb.Name & "        'a pas la bonne structure": Exit Sub
    dl = re.Row - 2
    col = ddjvt(0) + 1        ' colonne du jour sélectionné
    'HORAIRE 1 : Ouverture Self 7H20-14H40       HORAIRE 5 : Self 10H35-17H55                        HORAIRE 7 : Self 14H05-21H25                        HORAIRE P : 9H05-16H25                          RH : Repos Hebdomadaire                 FE : Jour Férié
    'HORAIRE 2 : Self 8H35-15H55                 HORAIRE 6 : Self 13H05-20H25                        HORAIRE 8 : Snack 8H35-15H55                        HORAIRE 3 : Prod Froide : 8H05-15H25                            CA : Congé Annuel                   FOR : Formation
    code2 = 29
    For i = 5 To dl
        If ws.Cells(i, 1) <> "" Then
            co = ws.Cells(i, col)
            Select Case co
                Case "RH", "CA", "FE", "FOR"
                Case 1
                    wsp.Range("g28") = ws.Cells(i, 1)
                Case 2
                    wsp.Cells(code2, "g") = ws.Cells(i, 1)
                    code2 = code2 + 1
                Case 5, 6, 7
                    wsp.Cells(co + 23, "i") = ws.Cells(i, 1)
                Case "P"
                    If wsp.Range("i33") = "" Then
                       wsp.Range("i33") = ws.Cells(i, 1)
                    Else
                       wsp.Range("i34") = ws.Cells(i, 1)
                    End If
            End Select
        End If
    Next i
    wb.Close False

    ' fichier seq2-planning-année-groupe-seq1.xls
    For seq1 = 1 To 3
        seq2 = seq1 + 1
        nf = Replace("seq2-planning-année-groupe-seq1.xls", "année", annee)
        nf = Replace(nf, "seq1", CStr(seq1))
        nf = Replace(nf, "seq2", CStr(seq2))
        Set wb = Workbooks.Open(chemin & nf)
        If wb Is Nothing Then MsgBox "fichier " & chemin & nf & " non trouvé": Exit Sub
        Set ws = wb.Sheets(mois)        'la feuille dans le classeur
        Set re = Nothing
        Set re = ws.Range("A1:A100").Find(" : ", lookat:=xlPart, MatchCase:=False)
        If re Is Nothing Then MsgBox "la feuille " & ws.Name & " du fichier " & wb.Name & "        'a pas la bonne structure": Exit Sub
        dl = re.Row - 2
        col = ddjvt(0) + 1        ' colonne du jour sélectionné
        '1 : Repas à domicile 6H35-13H55             PLM : Laverie Matin 7H05-14H25                      5 : Tranchage W.E. 6H35-13H55
        '2 : Repas à domicile 8H05-15H25             7 : Laverie Soir 13H05-20H25                        6 : Déconditionnement W.E. 7H05-14H25
        '3 : Production Froide 8H05-15H25                8 : Laverie  9H35-16H55                     CRE: crèche
        '4 : Production Froide 6H35-13H55                SK : Snack : 8H05-15H25

        code3 = 8
        code7 = 10
        For i = 5 To dl
            If ws.Cells(i, 1) <> "" Then
                co = ws.Cells(i, col)
                Select Case co
                    Case "RH", "CA", "FE", "FOR"
                    Case 0
                        wsp.Range("i8") = ws.Cells(i, 1)
                    Case 1
                        If wsp.Range("c8") = "" Then
                            wsp.Range("c8") = ws.Cells(i, 1)
                        Else
                            wsp.Range("c9") = ws.Cells(i, 1)
                        End If
                    Case 2
                        If wsp.Range("c10") = "" Then
                            wsp.Range("c10") = ws.Cells(i, 1)
                        Else
                            wsp.Range("c11") = ws.Cells(i, 1)
                        End If
                    Case 3
                        If code3 < 13 Then
                           wsp.Cells(code3, "g") = ws.Cells(i, 1)
                           code3 = code3 + 1
                        End If
                    Case 4
                        If wsp.Range("e8") = "" Then
                            wsp.Range("e8") = ws.Cells(i, 1)
                        Else
                            wsp.Range("e9") = ws.Cells(i, 1)
                        End If
                    Case "PLM"
                        wsp.Range("k8") = ws.Cells(i, 1)
                    Case 7
                        If code7 < 13 Then
                           wsp.Cells(code7, "K") = ws.Cells(i, 1)
                           code7 = code7 + 1
                        End If
                    Case 8
                        wsp.Range("k9") = ws.Cells(i, 1)
                    Case "SK"
                        wsp.Range("i11") = ws.Cells(i, 1)
                    Case "CRE"
                End Select
            End If
        Next i
        wb.Close False
    Next seq1

    ' fichier seq2-planning-année-prod-chaude-seq1.xls
    For seq1 = 1 To 2
        seq2 = seq1 + 4
        nf = Replace("seq2-planning-année-prod-chaude-seq1.xls", "année", annee)
        nf = Replace(nf, "seq1", CStr(seq1))
        nf = Replace(nf, "seq2", CStr(seq2))
        Set wb = Workbooks.Open(chemin & nf)
        If wb Is Nothing Then MsgBox "fichier " & chemin & nf & " non trouvé": Exit Sub
        Set ws = wb.Sheets(mois)        'la feuille dans le classeur
        Set re = Nothing
        Set re = ws.Range("A1:A100").Find(" : ", lookat:=xlPart, MatchCase:=False)
        If re Is Nothing Then MsgBox "la feuille " & ws.Name & " du fichier " & wb.Name & "        'a pas la bonne structure": Exit Sub
        dl = re.Row - 2
        col = ddjvt(0) + 1        ' colonne du jour sélectionné
        'PT1 : Pâtisserie : 06H05-13H25              PV1 : Production Viande : 6H05-13H25                D1 : Décondit. 1 : 06H05-13H25                      0 : Prod. Froide Sem. 13H05-20H25                       PF3:Prod froide 8h                  RH : Repos Hebdomadaire
        'PT2 : Pâtisserie : 09H05-16H25              PV2 : Production Viande : 7H05-14H25                D2 : Décondit. 2 : 07H5-14H25                       7 : Prod. Froide W.E. 11H05-18H25                                           CA : Congés Annuels
        'DT1 : Diététique : 06H05-13H25              L1 : Légumes : 6H05- 13H25                          D3 : Décondit. 3 : 11H05-18H25                      CF : Ch. Fr. Prod. Fin. : 07H05-14H25                                           FE : Jour Férié
        'DT2 : Diététique : 09H05-16H25              L2 : Légumes : 7H05-14H25                           B : Boucherie : 06H35-13H55                         OP : Operculage : 08H05-15H25                                           FOR : Formation
        '10 : Acheminement 5H35-12H55                A : Acheminement 6H35-13H55 CAP                         CE : Cellule :  8h05-13h25                      HJ : 7H05-14H25         CR : 6H35 - 13H55

        code2 = 11
        codeplus = 22
        For i = 5 To dl
            If ws.Cells(i, 1) <> "" Then
                co = ws.Cells(i, col)
                Select Case co
                    Case "RH", "CA", "FE", "FOR"
                    Case "PT1"
                        wsp.Range("g22") = ws.Cells(i, 1)
                    Case "PT2"
                        wsp.Range("g23") = ws.Cells(i, 1)
                    Case "DT1"
                        wsp.Range("i22") = ws.Cells(i, 1)
                    Case "DT2"
                        wsp.Range("i23") = ws.Cells(i, 1)
                    Case "PV1"
                        wsp.Range("e16") = ws.Cells(i, 1)
                    Case "PV2"
                        wsp.Range("e17") = ws.Cells(i, 1)
                    Case "PL1"
                        wsp.Range("e20") = ws.Cells(i, 1)
                    Case "PL2"
                        wsp.Range("e21") = ws.Cells(i, 1)
                    Case "D1"
                        wsp.Range("c16") = ws.Cells(i, 1)
                    Case "D2"
                        wsp.Range("c17") = ws.Cells(i, 1)
                    Case "D3"
                        wsp.Range("c18") = ws.Cells(i, 1)
                    Case "OP"
                        wsp.Range("c21") = ws.Cells(i, 1)
                    Case "A"
                        wsp.Range("i19") = ws.Cells(i, 1)
                    Case "B"
                        wsp.Range("c24") = ws.Cells(i, 1)
                    Case "CF"
                        wsp.Range("g16") = ws.Cells(i, 1)
                    Case "CE"
                        wsp.Range("g19") = ws.Cells(i, 1)
                    Case "UB"
                        wsp.Range("k19") = ws.Cells(i, 1)
                    Case "HJ", "HDJ"
                        wsp.Range("k16") = ws.Cells(i, 1)
                    Case 10
                        wsp.Range("i16") = ws.Cells(i, 1)
                    Case "+"
                        If codeplus < 25 Then
                           wsp.Cells(code7, "K") = ws.Cells(i, 1)
                           codeplus = codeplus + 1
                        End If
                End Select
            End If
        Next i
        wb.Close False
    Next seq1

    ' fichier 7-planning-année-magasin.xls
    nf = Replace("7-planning-année-magasin.xls", "année", annee)
    Set wb = Workbooks.Open(chemin & nf)
    If wb Is Nothing Then MsgBox "fichier " & chemin & nf & " non trouvé": Exit Sub
    Set ws = wb.Sheets(mois)        'la feuille dans le classeur
    Set re = Nothing
    Set re = ws.Range("A1:A100").Find("G1 :", lookat:=xlPart, MatchCase:=False)
    If re Is Nothing Then MsgBox "la feuille " & ws.Name & " du fichier " & wb.Name & "        'a pas la bonne structure": Exit Sub
    dl = re.Row - 2
    col = ddjvt(0) + 1        ' colonne du jour sélectionné
    'HORAIRE A : 08H05 - 15H25
    'HORAIRE B : 10H05 - 17H25
    code2 = 31
    For i = 5 To dl
        If ws.Cells(i, 1) <> "" Then
            co = ws.Cells(i, col)
            Select Case co
                Case "RH", "CA", "FE", "FOR"
                Case "G1"
                    wsp.Range("C28") = ws.Cells(i, 1)
                Case "G2"
                    wsp.Range("C29") = ws.Cells(i, 1)
                Case 1
                    wsp.Range("C30") = ws.Cells(i, 1)
                Case 2
                    If code2 < 35 Then
                       wsp.Cells(code2, "c") = ws.Cells(i, 1)
                       code2 = code2 + 1
                    End If
            End Select
        End If
    Next i
    wb.Close False

    ' fichier 8-planning-année-creche.xls
    nf = Replace("8-planning-année-creche.xls", "année", annee)
    Set wb = Workbooks.Open(chemin & nf)
    If wb Is Nothing Then MsgBox "fichier " & chemin & nf & " non trouvé": Exit Sub
    Set ws = wb.Sheets(mois)        'la feuille dans le classeur
    Set re = Nothing
    Set re = ws.Range("A1:A100").Find("HORAIRE", lookat:=xlPart, MatchCase:=False)
    If re Is Nothing Then MsgBox "la feuille " & ws.Name & " du fichier " & wb.Name & "        'a pas la bonne structure": Exit Sub
    dl = re.Row - 2
    col = ddjvt(0) + 1        ' colonne du jour sélectionné

    code2 = 28
    For i = 5 To dl
        If ws.Cells(i, 1) <> "" Then
            co = ws.Cells(i, col)
            Select Case co
                Case "RH", "CA", "FE", "FOR"
                Case "CR"
                    If code2 < 31 Then
                       wsp.Cells(code2, "e") = ws.Cells(i, 1)
                       code2 = code2 + 1
                    End If
            End Select
        End If
    Next i
    wb.Close False

    ' fichier 9-planning-année-greenbox.xls
    nf = Replace("9-planning-année-greenbox.xls", "année", annee)
    Set wb = Workbooks.Open(chemin & nf)
    If wb Is Nothing Then MsgBox "fichier " & chemin & nf & " non trouvé": Exit Sub
    Set ws = wb.Sheets(mois)        'la feuille dans le classeur
    Set re = Nothing
    Set re = ws.Range("A1:A100").Find("HORAIRE", lookat:=xlPart, MatchCase:=False)
    If re Is Nothing Then MsgBox "la feuille " & ws.Name & " du fichier " & wb.Name & "        'a pas la bonne structure": Exit Sub
    dl = re.Row - 2
    col = ddjvt(0) + 1        ' colonne du jour sélectionné
    'HORAIRE A : 08H05 - 15H25
    'HORAIRE B : 10H05 - 17H25
    code2 = 33
    For i = 5 To dl
        If ws.Cells(i, 1) <> "" Then
            co = ws.Cells(i, col)
            Select Case co
                Case "RH", "CA", "FE", "FOR"
                Case "A"
                    wsp.Range("e32") = ws.Cells(i, 1)
                Case "B"
                    If code2 < 35 Then
                       wsp.Cells(code2, "e") = ws.Cells(i, 1)
                       code2 = code2 + 1
                    End If
            End Select
        End If
    Next i
    wb.Close False

    ' fichier 10-planning-année-responsables-cuisine1.xls
    nf = Replace("10-planning-année-responsables-cuisine1.xls", "année", annee)
    Set wb = Workbooks.Open(chemin & nf)
    If wb Is Nothing Then MsgBox "fichier " & chemin & nf & " non trouvé": Exit Sub
    Set ws = wb.Sheets(mois)        'la feuille dans le classeur
    Set re = Nothing
    Set re = ws.Range("A1:A100").Find(" : ", lookat:=xlPart, MatchCase:=False)
    If re Is Nothing Then MsgBox "la feuille " & ws.Name & " du fichier " & wb.Name & "        'a pas la bonne structure": Exit Sub
    dl = re.Row - 2
    col = ddjvt(0) + 1        ' colonne du jour sélectionné
    'HORAIRE A : 08H05 - 15H25
    'HORAIRE B : 10H05 - 17H25
    codeP = 28
    For i = 5 To dl
        If ws.Cells(i, 1) <> "" Then
            co = ws.Cells(i, col)
            Select Case co
                Case "RH", "CA", "FE", "FOR"
                Case "P"
                    If codeP < 35 Then
                      wsp.Cells(codeP, "k") = ws.Cells(i, 1)
                      codeP = codeP + 1
                    End If
            End Select
        End If
    Next i
    wb.Close False
End Sub
Function ddjok(ddj)
    'fonction de validation d'une date format j/m/a

    Dim ddjv(0 To 2) As Long
    ddjok = False
    ddjvt = Split(ddj & "/", "/")
    If UBound(ddjvt) <> 3 Then Exit Function
    If Len(ddjvt(2)) <> 2 And Len(ddjvt(2)) <> 4 Then Exit Function
    For i = 0 To 2
        If Not IsNumeric(ddjvt(i)) Then Exit Function
        ddjv(i) = CLng(ddjvt(i))
    Next i
    If ddjv(1) > 12 Or ddjv(1) = 0 Then Exit Function
    Select Case ddjv(1)
        Case 1, 3, 5, 7, 8, 10, 12
            If ddjv(0) > 31 Then Exit Function
        Case 4, 6, 9, 11
            If ddjv(0) > 30 Then Exit Function
        Case 2
            If ddjv(0) > (28 + IIf((ddjv(2) Mod 4) = 0, 1, 0)) Then Exit Function
        Case Else
            Exit Function
    End Select
    ddjok = True
End Function
Function moisok(ddj)
    'fonction de validation d'une date format j/m/a

    Dim ddjv(0 To 1) As Long
    moisok = False
    ddjvt = Split(ddj & "/", "/")
    If UBound(ddjvt) <> 2 Then Exit Function
    For i = 0 To 1
        If Not IsNumeric(ddjvt(i)) Then Exit Function
        ddjv(i) = CLng(ddjvt(i))
    Next i
    If ddjv(0) > 12 Or ddjv(0) = 0 Then Exit Function
    If Len(ddjvt(1)) <> 2 And Len(ddjvt(1)) <> 4 Then Exit Function
    moisok = True
End Function

Ok j'ai réussi à ne pas être bloqué avec les macros, cependant j'ai ce message d'erreur en ayant tester de renommer le self comme il fallait, et en mettant le bon répertoire, regarde.

Ca fait pareil en renommant avec l'année : 1-planning-2025-self.xls

image

Cependant je vois pour essayer de me faire débloquer les macros par l'informatique de mon hôpital, afin qu'on avance un peu mieux sur le sujet.

re,

dans ce fichier, la macro s'attend à trouver une feuille dont le nom est juillet 2025, si la date demandée est une date de juillet 2025. pour faire la macro je me suis basé sur les fichiers de test que tu as mis dans lequel les feuilles portent le nom de mois suivi de l'année Si le nom de feuille ne respecte pas cette structure tu reçois le message d'erreur 9.

Ok désolé de ramer autant, j'ai bien renommé tous les fichiers, et cela semble marcher partiellement, c'est déjà énorme ! Merci !!

J'ai donc eu ce message d'erreur à valider 31 fois pour le mois de Juillet !

image

Cependant cela n'a fonctionné qu'avec le planning du self, et pareil, de manière incomplète. Par exemple le 6 Juillet il manque du monde.

Encore merci pour tout ce temps que tu m'accordes, car je vois bien que je pars de loin. Merci.

re-bonjour,

fais d'abord les tests de ton coté avec les fichiers planning que tu as mis sur le forum et vérifie que tu as bien le résultat attendu. Fais le test pour quelques jours clés pour lesquels tu peux facilement vérifier le résultat. (pour éviter de devoir valider 31 fois, le même message d'erreur)

On essaiera de voir par après pourquoi cela ne fonctionne pas avec tes vrais fichiers.

Rien d'important dans le fait de valider le message au final.

Là j'ai vu en diagonale que des fois ceux du self en Echelle / Porte et P P n'étaient pas piles alignés là où c'était prévu, et que certains jours il manquait des agents.

Je regarde de plus près et je reviens vers toi, sachant que je ne peux voir que le Self en l'état, rien n'apparait pour le reste.

Encore merci pour tout !

pour déterminer la fin de la liste des personnes dans le planning je me suis basé sur un invariant que se trouve dans tous tes fichiers de tests, à savoir une cellule en colonne A qui contient la séquence de caractères  :  une ligne après le dernier nom

le fichier est considéré comme n'ayant pas la bonne structure si cette séquence n'est pas trouvée.

Bonjour,

Je suis de retour, et cette fois-ci j'ai essayé de dompter ChatGPT qui m'a fait une macro pas trop mal qui fonctionne bien.

En PJ les deux fichiers, j'ai désormais réuni sur un seul fichier l'ensemble des plannings du mois en cours pour + de simplicité.

Si jamais vous souhaitez étudier la macro faite par notre ami IA, vous pouvez l'appliquer dans le doc Personnel du jour.

Désolé pour la perte de temps mais finalement ces échanges ont fini par me mettre sur cette voie là, ce qui me permettait de ne pas vous solliciter pour tout et rien.

Rechercher des sujets similaires à "transmettre infos planning feuille jour"