Microsoft 365 Création d'un code VBA pour sélectionner des zone selon choix multiples.

[Lionel Alfred]

Bonjour à vous tous,
je suis dans un train de créer un fichier pour les horaires, et dans le but de faciliter le travail "administratif" des personnes en charge de gérer le personnel, j'ai créé une feuille Excel avec les horaires, et des tableaux pour les employés.
Il y a la possibilité d'avoir 6 employés, mais parfois un employé qui se situe au milieu du fichier n'est plus présent.

Ma question est la suivante: j'ai tenté de créer un "bouton" imprimer avec un module VBA, ce dernier devant sélectionner les zones en fonction d'un critère.
Pour expliquer le "concept", si un nom d'employé est écrit à la place de la mention "employé n (1 à 6)", la cellule en T1 passe de zéro à un.
Une fois la cellule "T1" sous le chiffre 1, et que le bouton est cliqué, alors il y a la sélection de la zone A1;J55, etc.
Mon problème est que lorsque je me retourne avec plusieurs valeurs "1", il y a uniquement la dernière zone qui est sélectionnée.

Je suis office 365, Windows 11.
Avec mes cordiales salutations, et remerciements

Lionel Alfred

 

[fanch55]

Bonjour,
Testez le code ci-dessous:

Sub Print_One()
Dim Cel As Range, Plage As Range, PrintArea As String
Application.ScreenUpdating = False
    For Each Cel In [T1:T6].Cells
        If Cel Then ' La cellule a la valeur 1
            On Error Resume Next ' Si jamais il n'y avait pas de formule dans la cellule
                Z = Split(Split(Cel.Formula, "=")(1), "("):         If Err Then Exit For
                Set Plage = [A:J].Rows(Range(Z(1)).Row).Resize(55): If Err Then Exit For
            On Error GoTo 0
           ' On insère un saut de page à la première ligne de "Page"
            Plage.Rows(1).Select:  ActiveWindow.View = xlPageBreakPreview
           ' On définit les zones à imprimer
            PrintArea = IIf(PrintArea = "", "", PrintArea & ",") & Plage.Address
        End If
    Next
    If PrintArea <> "" Then ' Quelque chose à imprimer
        With ActiveSheet.PageSetup
            .PrintArea = PrintArea
            .LeftMargin = 0:   .RightMargin = 0
            .TopMargin = 0:    .BottomMargin = 0
            .HeaderMargin = 0: .FooterMargin = 0
        End With
        Application.ScreenUpdating = True
        ActiveSheet.PrintPreview
    End If

End Sub

 

[Lionel Alfred]

Bonjour,
Testez le code ci-dessous:

Sub Print_One()
Dim Cel As Range, Plage As Range, PrintArea As String
Application.ScreenUpdating = False
    For Each Cel In [T1:T6].Cells
        If Cel Then ' La cellule a la valeur 1
            On Error Resume Next ' Si jamais il n'y avait pas de formule dans la cellule
                Z = Split(Split(Cel.Formula, "=")(1), "("):         If Err Then Exit For
                Set Plage = [A:J].Rows(Range(Z(1)).Row).Resize(55): If Err Then Exit For
            On Error GoTo 0
           ' On insère un saut de page à la première ligne de "Page"
            Plage.Rows(1).Select:  ActiveWindow.View = xlPageBreakPreview
           ' On définit les zones à imprimer
            PrintArea = IIf(PrintArea = "", "", PrintArea & ",") & Plage.Address
        End If
    Next
    If PrintArea <> "" Then ' Quelque chose à imprimer
        With ActiveSheet.PageSetup
            .PrintArea = PrintArea
            .LeftMargin = 0:   .RightMargin = 0
            .TopMargin = 0:    .BottomMargin = 0
            .HeaderMargin = 0: .FooterMargin = 0
        End With
        Application.ScreenUpdating = True
        ActiveSheet.PrintPreview
    End If

End Sub

Bonjour fanch55, merci pour ta proposition, je vais essayer de la mettre dans mon fichier, et je vois tiens au courant. Lionel Alfred

 

[Lionel Alfred]

Bonjour,
Testez le code ci-dessous:

Sub Print_One()
Dim Cel As Range, Plage As Range, PrintArea As String
Application.ScreenUpdating = False
    For Each Cel In [T1:T6].Cells
        If Cel Then ' La cellule a la valeur 1
            On Error Resume Next ' Si jamais il n'y avait pas de formule dans la cellule
                Z = Split(Split(Cel.Formula, "=")(1), "("):         If Err Then Exit For
                Set Plage = [A:J].Rows(Range(Z(1)).Row).Resize(55): If Err Then Exit For
            On Error GoTo 0
           ' On insère un saut de page à la première ligne de "Page"
            Plage.Rows(1).Select:  ActiveWindow.View = xlPageBreakPreview
           ' On définit les zones à imprimer
            PrintArea = IIf(PrintArea = "", "", PrintArea & ",") & Plage.Address
        End If
    Next
    If PrintArea <> "" Then ' Quelque chose à imprimer
        With ActiveSheet.PageSetup
            .PrintArea = PrintArea
            .LeftMargin = 0:   .RightMargin = 0
            .TopMargin = 0:    .BottomMargin = 0
            .HeaderMargin = 0: .FooterMargin = 0
        End With
        Application.ScreenUpdating = True
        ActiveSheet.PrintPreview
    End If

End Sub

Bonjour fanch55, un peu de temps pour me remettre sur le projet. Un grand merci pour ton aide, le programme fonctionne à merveille. U(n GROS POUCE LIKE pour toi.
Cordiales salutations
Lionel Alferd