Souci d'ajustement d'aperçu avant impression macro a revoir

Le 28/12/2023 à 21:30

Bonsoir BsAlv, ta macro ne fonctionne pas, il n'y a aucun aperçu

Le 28/12/2023 à 21:44

re, vous utiliser "muratime" ?

maintenant avec export vers 2 pdfs.

5muratime-souci-d-ajustement-d-apercu-avant-impression-macro-a-revoir-1.xlsm (269.83 Ko)
Le 28/12/2023 à 21:48

oui, il me semble que sur Excel 2007 je ne peux exporter en pdf

sans titre
Le 28/12/2023 à 22:39

oei, je ne me rappèle plus 100%, il faut créer un filename et savoir le PDF-printer et ...

Application.ActivePrinter = "CutePDF Writer on CPW2:"
Activesheet.PrintOut Copies:=1, ActivePrinter:= "CutePDF Writer on CPW2:", PrintToFile:=True, Collate:=True, prtofilename:=fileName

Mais maintenant vous avez 2 aperçus ?

Le 28/12/2023 à 22:52

Si je prend le premier fichier j'ai que un seul aperçu ça Français math et ensuite plus rien avec cette macro

sans titre 
Sub Muratime()

     With Sheets("elève 16")
          With .PageSetup
               .PrintArea = "A8:F48,A49:G91,A93:F120,A122:G157,A159:F218"
               .PrintTitleRows = "$1:$7"
               .Zoom = False
               .FitToPagesWide = 1
               .FitToPagesTall = 5

               .LeftMargin = Application.InchesToPoints(0.5)
               .RightMargin = Application.InchesToPoints(0.2)
               .TopMargin = Application.InchesToPoints(0.1)
               .BottomMargin = Application.InchesToPoints(0.1)
               .CenterFooter = "Page &P / &N"
               .FooterMargin = Application.InchesToPoints(0.1)

          End With
          .PrintPreview
     End With
End Sub
Le 29/12/2023 à 00:29

si vous remplacer le ".printpreview" par ".printout", vous recevez les 5 pages ?

9muratime-souci-d-ajustement-d-apercu-avant-impression-macro-a-revoir-1.xlsm (271.28 Ko)
6muratime-montrer-233631229-004732.zip (445.15 Ko)
9muratime-masquer-233631229-004724.zip (426.57 Ko)
Le 29/12/2023 à 01:03

j'ai ça page 1, 2, 3, 4, 5 pages

sans titre sans titre sans titre sans titre sans titre
Le 29/12/2023 à 01:10

c'est excéllent, non ? Y-a-t-il encore des défauts ? Et vous avez les 2 versions "montrer" et "masquer"

Le 29/12/2023 à 01:29

Disons que masquer ça masque dans colonne E ou c'est écrit "Non travaillé" du coup ça raccourci le document avec la version de Arthuro quand ça fonctionne du premier coup, ça je ne l'explique pas un coup j'ai le document sur 3 pages et des fois 4 par contre ma macro pour le cycle 3 ça marche pas avec une seule ligne Non travaillé le truc est de bistacoin

Le 29/12/2023 à 01:40

Il faudrait revoir le cycle 3, j'ai que 3 pages alors que je devrais en avoir 4 au moins avec une seule ligne de masqué par contre avec non masqué il y a tous

11demo-2.xlsm (285.63 Ko)

j'avais une question pourquoi H7 ?

' Boucle pour afficher l'aperçu avant impression pour chaque page
    For Page = 1 To 5
        Select Case Page
            Case 1
                If Range("H7").Value = "x" Then 'c'est que toutes les compétences non travaillées sont affichées
                    Set PlageImprimer = ActiveSheet.Range("A1:F48")
                ElseIf Cells(NbLigParPage * Page, "A").Interior.Color = RGB(0, 0, 0) Then
                    DerLig1 = NbLigParPage * Page
                    Set PlageImprimer = ActiveSheet.Range("A1:F" & DerLig1)
                Else
                    For i = NbLigParPage * Page To 1 Step -1
                        If Cells(i, "A").Interior.Color = RGB(0, 0, 0) Then
                            DerLig1 = i
                            Set PlageImprimer = ActiveSheet.Range("A1:F" & DerLig1)
                            Exit For
                        End If
                    Next i
                End If
Le 29/12/2023 à 04:58

Bonjour à tous,

Dans mon fichier, j'avais grisé la ligne 215, celle-ci étant la dernière de la feuille. Il faut la conserver car c'est à partir de toutes ces lignes grisées que je vais positionner le saut de page, si elle n'y est plus, il va manquer la dernière partie, celle qui contient les signatures.

Vous pouvez réduire la hauteur de cette ligne si vous souhaitez ne pas la voir apparaitre sur l'impression, ça marchera quand même.

Cdlt

Le 29/12/2023 à 10:39

re et Arturo83,

Donc "masquer" est en 4 pages ?

31muratime-souci-d-ajustement-d-apercu-avant-impression-macro-a-revoir-1.xlsm (271.81 Ko)
Sub Muratime()

     With Sheets("elève 16")
          For i = 1 To 2
               If i = 1 Then MasquerLignes Else MontrerLignes

               With .PageSetup
                    .PrintArea = IIf(i = 2, "A8:F48,A49:G91,A93:F120,A122:G157,A159:F218", "A8:F48,A49:G76,A77:F157,A159:G218")     '4 ou 5 plages
                    .PrintTitleRows = "$1:$7"
                    .Zoom = False
                    .FitToPagesWide = 1
                    .FitToPagesTall = IIf(i = 2, 5, 4)     '4 ou 5 pages

                    .LeftMargin = Application.InchesToPoints(0.5)
                    .RightMargin = Application.InchesToPoints(0.2)
                    .TopMargin = Application.InchesToPoints(0.1)
                    .BottomMargin = Application.InchesToPoints(0.1)
                    .CenterFooter = "Page &P / &N"
                    .FooterMargin = Application.InchesToPoints(0.1)

               End With
               .PrintPreview
               If Application.UserName <> "BSA" Then     'ordinateur<>Cow18 (avec excel<=2007)
                    Application.Dialogs(xlDialogPrinterSetup).Show     'choississez votre pdf-printer installé (chez moi : "Microsoft print to pdf on Ne02:")
                    ActiveSheet.PrintOut Copies:=1, PrintToFile:=True, Collate:=True, prtofilename:=ThisWorkbook.Path & "\muratime-" & IIf(i = 1, "Masquer-", "Montrer-") & Format(Now, "yyymmdd-hhmmss") & ".pdf"
               Else                          'ordinateur de Cow18 ou avec excel >2007
                    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\muratime-" & IIf(i = 1, "Masquer-", "Montrer-") & Format(Now, "yyymmdd-hhmmss"), OpenAfterPublish:=True
               End If

          Next
     End With
End Sub
Le 29/12/2023 à 12:53

Bonjour Bart, Arthuro masquer n'est pas forcement en 4 pages sur mon fichier original le cycle 3 avec tout affiché c'est 4 pages max et sur cycle 4 c'est 5 pages max voici les deux macros originales que j'avais faite. C'est juste pour l'aperçu pour imprimer c'est pareil sauf le PrintPreview qui sera PrintOut. Dans le code de Arturo la feuille Elève16 avec masqué j'ai plus que 3 pages au lieu des 5 donc ça dépend de combien de ligne sera masqué.

Cycle 3

Sub ApercuAvantImpression()
    Dim PlageImprimer As Range
    Dim Page As Integer

    Application.ScreenUpdating = False

    ' Référencer la feuille active
    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' Boucle pour afficher l'aperçu avant impression pour chaque page
    For Page = 1 To 4
        Select Case Page
            Case 1
                Set PlageImprimer = ws.Range("A1:F68")
            Case 2
                Set PlageImprimer = ws.Range("A70:F111")
            Case 3
                Set PlageImprimer = ws.Range("A112:F166")
            Case 4
                Set PlageImprimer = ws.Range("A168:F204")
        End Select

        ' Définir le zoom à 60%
        ws.PageSetup.Zoom = 60

        ' Définir la plage d'impression sur la feuille active
        ws.PageSetup.PrintArea = PlageImprimer.Address

        ' Personnaliser les marges d'impression si nécessaire
        With ws.PageSetup
            .LeftMargin = Application.InchesToPoints(0.5)
            .RightMargin = Application.InchesToPoints(0.2)
            .TopMargin = Application.InchesToPoints(0.2)
            .BottomMargin = Application.InchesToPoints(0.2)
        End With

        ' Spécifier l'entête A1:F7 pour les pages 2, 3 et 4
        If Page > 1 Then
            With ws.PageSetup
                .PrintTitleRows = "$1:$7"
            End With
        End If

        ' Ajouter un numéro de page en bas de chaque page
        With ws.PageSetup
            .CenterFooter = "Page " & Page
        End With

        ' Afficher l'aperçu avant impression pour la plage actuelle
        PlageImprimer.PrintPreview

        ' Réinitialiser la plage d'impression
        ws.PageSetup.PrintArea = ""

        ' Réinitialiser l'entête et le numéro de page pour la page suivante
        If Page > 1 Then
            With ws.PageSetup
                .PrintTitleRows = ""
                .CenterFooter = ""
            End With
        End If
    Next Page

    ' Réinitialiser les paramètres de la page
    With ws.PageSetup
        .PrintTitleRows = ""
        .CenterFooter = ""
    End With

    Application.ScreenUpdating = True
End Sub

Cycle 4

Sub ApercuAvantImpression2()
    Dim PlageImprimer As Range
    Dim Page As Integer

    Application.ScreenUpdating = False

    ' Référencer la feuille active
    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' Boucle pour afficher l'aperçu avant impression pour chaque page
    For Page = 1 To 5
        Select Case Page
            Case 1
                Set PlageImprimer = ActiveSheet.Range("A1:F48")
            Case 2
                Set PlageImprimer = ActiveSheet.Range("A49:F91")
            Case 3
                Set PlageImprimer = ActiveSheet.Range("A93:F120")
            Case 4
                Set PlageImprimer = ActiveSheet.Range("A122:F157")
            Case 5
                Set PlageImprimer = ActiveSheet.Range("A159:F218")
        End Select

        ' Définir le zoom à 60%
        ActiveSheet.PageSetup.Zoom = 60

        ' Définir la plage d'impression sur la feuille active
        ActiveSheet.PageSetup.PrintArea = PlageImprimer.Address

        ' Personnaliser les marges d'impression si nécessaire
        With ActiveSheet.PageSetup
            .LeftMargin = Application.InchesToPoints(0.5)
            .RightMargin = Application.InchesToPoints(0.2)
            .TopMargin = Application.InchesToPoints(0.1)
            .BottomMargin = Application.InchesToPoints(0.1)
        End With

        ' Spécifier l'entête A1:F7 pour les pages 2, 3 et 4
        If Page > 1 Then
            With ActiveSheet.PageSetup
                .PrintTitleRows = "$1:$7"
            End With
        End If

        ' Ajouter un numéro de page en bas de chaque page
        With ActiveSheet.PageSetup
            .CenterFooter = "Page " & Page
            .FooterMargin = Application.InchesToPoints(0.1)
        End With

        ' Afficher l'aperçu avant impression pour la plage actuelle
        PlageImprimer.PrintPreview

        ' Réinitialiser la plage d'impression
        ActiveSheet.PageSetup.PrintArea = ""

        ' Réinitialiser l'entête et le numéro de page pour la page suivante
        If Page > 1 Then
            With ActiveSheet.PageSetup
                .PrintTitleRows = ""
                .CenterFooter = ""
            End With
        End If
    Next Page

    ' Réinitialiser les paramètres de la page
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .CenterFooter = ""
    End With

    Application.ScreenUpdating = True
End Sub
Le 29/12/2023 à 12:57

Bonjour muratine,

Avez-vous vu ma remarque de ce matin à 4h58 concernant la dernière ligne grisée?

Le 29/12/2023 à 13:03

Oui merci Arthuro j'y est pensé c'est dans le fichier Démo2 si tu créer une autre feuille de Elève16 c'est ajouté avec hauteur de 1. J'ai aussi ajouté ça à la création de la feuille le x en H7 pas dans ce fichier Démo2 sur mon original, c'est en regardant de plus près que je demandais d'ou venait le H7 et le x. J'ai ajusté le preview du cycle 3 pas simple.

Le 29/12/2023 à 13:15

Et j'avais une question pour Bart dans ton dernier fichier il faut Adobe reader mais lequel? Je voudrais essayer sur ma VM et excel 2016.

Le 30/12/2023 à 01:51

re,

nouvelle version

Normallement chaque PDF reader fonctionne, donc ce n'est pas nécessairement Adobe.

7muratime-souci-d-ajustement-d-apercu-avant-impression-macro-a-revoir-1.xlsm (282.71 Ko)
Le 30/12/2023 à 02:48

J'ai une question comment tu fais pour que le "Non travaillé" soit masqué dans ce code ?

Sub Muratime()

     With Sheets("elève 16")
          For i = 1 To 2
               If i = 1 Then MasquerLignes Else MontrerLignes

               With .PageSetup
                    .PrintArea = IIf(i = 2, "A8:F48,A49:G91,A93:F120,A122:G157,A159:F218", "A8:F48,A49:G76,A77:F157,A159:G218")     '4 ou 5 plages
                    .PrintTitleRows = "$1:$7"
                    .Zoom = False
                    .FitToPagesWide = 1
                    .FitToPagesTall = IIf(i = 2, 5, 4)     '4 ou 5 pages

                    .LeftMargin = Application.InchesToPoints(0.5)
                    .RightMargin = Application.InchesToPoints(0.2)
                    .TopMargin = Application.InchesToPoints(0.1)
                    .BottomMargin = Application.InchesToPoints(0.1)
                    .CenterFooter = "Page &P / &N"
                    .FooterMargin = Application.InchesToPoints(0.1)

               End With
               .PrintPreview
               If Application.UserName <> "BSA" Then     'ordinateur<>Cow18 (avec excel<=2007)
                    Application.Dialogs(xlDialogPrinterSetup).Show     'choississez votre pdf-printer installé (chez moi : "Microsoft print to pdf on Ne02:")
                    ActiveSheet.PrintOut Copies:=1, PrintToFile:=True, Collate:=True, prtofilename:=ThisWorkbook.Path & "\muratime-" & IIf(i = 1, "Masquer-", "Montrer-") & Format(Now, "yyymmdd-hhmmss") & ".pdf"
               Else                          'ordinateur de Cow18 ou avec excel >2007
                    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\muratime-" & IIf(i = 1, "Masquer-", "Montrer-") & Format(Now, "yyymmdd-hhmmss"), OpenAfterPublish:=True
               End If

          Next
     End With
End Sub
Le 30/12/2023 à 04:20

Re, la macro masque ou montre les "Non-travaillés" dans ce loop for i=1 to 2 et la ligne suivante fait ce choix , masquer ou montrer en lançant, l'une ou l'autre macro.

 With Sheets("elève 16")
          For i = 1 To 2
               If i = 1 Then MasquerLignes Else MontrerLignes
               ...
Le 30/12/2023 à 05:05

Pour le coup j'ai rajusté Elève16 et me dis que je pourrais supprimer le bouton + et - mais pas la macro et remplacer les deux boutons vert et bleu par deux macro une pour exporter en pdf avec masqué et l'autre tout montrer car le résultat est pas mal check ça en bas le pdf par contre j'ai mis en xps vu que excel 2007 ne supporte pas pdf c'est a partir de 2010 et la macro pour juste 1 document

Sub Muratime3()

    Dim i As Integer
    Dim fileName As String
    Dim activeSheetName As String

    ' Obtenez le nom de la feuille active
    activeSheetName = ActiveSheet.Name

    With ActiveSheet ' Utilisez la feuille active
        MasquerLignes

        With .PageSetup
            .PrintArea = "A8:F75,A77:F157,A159:G218" ' La plage unique que vous souhaitez utiliser
            .PrintTitleRows = "$1:$7"
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 5 '5 pages

            .LeftMargin = Application.InchesToPoints(0.5)
            .RightMargin = Application.InchesToPoints(0.2)
            .TopMargin = Application.InchesToPoints(0.1)
            .BottomMargin = Application.InchesToPoints(0.1)
            .CenterFooter = "Page &P / &N"
            .FooterMargin = Application.InchesToPoints(0.1)
        End With

        .PrintPreview

        ' Générez le nom du fichier en utilisant le nom de la feuille active
        fileName = activeSheetName & "-" & Format(Now, "ddmmyyyy")

        If Application.UserName <> "BSA" Then 'ordinateur<>Cow18 (avec excel<=2007)
            Application.Dialogs(xlDialogPrinterSetup).Show 'choississez votre pdf-printer installé (chez moi : "Microsoft print to pdf on Ne02:")
            ActiveSheet.PrintOut Copies:=1, PrintToFile:=True, Collate:=True, prtofilename:=ThisWorkbook.Path & "\" & fileName & ".xps"
        Else 'ordinateur de Cow18 ou avec excel >2007
            .ExportAsFixedFormat Type:=xlTypeXPS, fileName:=ThisWorkbook.Path & "\" & fileName & ".xps", OpenAfterPublish:=True
        End If

    End With

End Sub
18eleve-16-30122023.pdf (206.70 Ko)
Rechercher des sujets similaires à "souci ajustement apercu impression macro revoir"