XL 2010 Editer en pdf dernière page Sans "les lignes à répéter du haut"

cathodique

cathodique

XLDnaute Barbatruc
Bonjour:),

Une feuille à éditer en PDF (ou imprimer ), sur laquelle une entête à reproduire sur toutes les pages sauf la dernière qui contient un petit encadré.
Je parvins à gérer les sauts de page mais je n'ai aucune idée pour ne pas imprimer l’entête sur la dernière page.
VB: 
Option Explicit
Sub mep()
    Dim dl As Long, col As Byte, HPage As Integer, VPage As Byte, x As Integer
    ActiveWindow.View = xlPageBreakPreview

    With ActiveSheet
        dl = .UsedRange.Rows.Count
        .ResetAllPageBreaks
        .PageSetup.PrintArea = "A1:k" & dl
        .PageSetup.PrintTitleRows = "$1:$4"
        HPage = .HPageBreaks.Count
        VPage = .VPageBreaks.Count
      
        If VPage >= 1 Then .VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
      
        If HPage >= 1 Then
            For x = dl To 1 Step -1
                If .Cells(x, 9).Borders(xlEdgeTop).LineStyle = xlContinuous Then
                    .HPageBreaks.Add Before:=Range("A" & x - 1)
                    Exit For
                End If
            Next x
        End If
    End With
    ActiveWindow.View = xlNormalView
End Sub
Merci pour votre aide.
 
Dernière édition:
Trier par date Trier par votes
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
c'est un piège bien connu le usedrange
malheureusement si tu veux persister a utiliser save Ad tu va devoir composer creer x feuille ou une seul avec le report 1:4 a chaque fois
avec bullzip et l'option coché tu n'aurais plus a faire quoi que ce soit
d'autant plus que ca pourrait te servir pour imprimer en pdf une page web ou toute autre fenêtre imprimable
et tu garderais uniquement ce code
VB: 
Sub test()

With ActiveSheet
    'dl = .UsedRange.Rows.Count    'Attention c'est pas bon si le usedrange ne commence pas en ligne 1
    dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row    'Là on est sur!!!!
  
    .PageSetup.PrintArea = "A6:E" & dl
    '
    'ton arrangement ici
    '
    nbpages = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
   
     'impression des pages (count-1)
    .PageSetup.PrintTitleRows = "$1:$4"
    ActiveSheet.PrintOut from:=1, To:=nbpages - 1    'On imprime tout jusqu'à l'avant dernière page

    'impression de la derniere page
    .PageSetup.PrintTitleRows = ""  'on enlève les entêtes
    ActiveSheet.PrintOut from:=nbpages, To:=nbpages    'On imprime la dernière page

End With
End Sub
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
patricktoulon à dit:
re
c'est un piège bien connu le usedrange
malheureusement si tu veux persister a utiliser save Ad tu va devoir composer creer x feuille ou une seul avec le report 1:4 a chaque fois
avec bullzip et l'option coché tu n'aurais plus a faire quoi que ce soit
d'autant plus que ca pourrait te servir pour imprimer en pdf une page web ou toute autre fenêtre imprimable
et tu garderais uniquement ce code
VB: 
Sub test()

With ActiveSheet
    'dl = .UsedRange.Rows.Count    'Attention c'est pas bon si le usedrange ne commence pas en ligne 1
    dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row    'Là on est sur!!!!

    .PageSetup.PrintArea = "A6:E" & dl
    '
    'ton arrangement ici
    '
    nbpages = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
 
     'impression des pages (count-1)
    .PageSetup.PrintTitleRows = "$1:$4"
    ActiveSheet.PrintOut from:=1, To:=nbpages - 1    'On imprime tout jusqu'à l'avant dernière page

    'impression de la derniere page
    .PageSetup.PrintTitleRows = ""  'on enlève les entêtes
    ActiveSheet.PrintOut from:=nbpages, To:=nbpages    'On imprime la dernière page

End With
End Sub
Cliquez pour agrandir...
Merci beaucoup Patrick,
Très gentil de ta part. Je retiens ta proposition avec bullzip (d'ailleurs je l'ai téléchargé mais pas installé).
Je n'ai qu'une seule alternative "une seule feuille" avec Save As et l’entête sur toutes les pages.
Bonne soirée en couvre-feu ☺️

edit: le piège de usedrange, je ne connais pas. même à mon âge, on a des lacunes ou des gouffres. Je ne sais pas, je ne sais plus :eek: :eek: :eek:
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
c'est pas grave la communauté est là
je baisse pas les bras j'apprend moi aussi en meme temps et comme je consigne tout je n'oublie jamais tout du moins mon disque dur special vba 😁

et si je te propose de ne pas ajouter de feuille mais de copier les unions a la suite en bas de la page concernée mettre les sauts de pages et dertmination du print area et imprimer cette plage et la supprimer ensuite
ça serait bien ça non? comme alternative
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
patricktoulon à dit:
re
bonjour @cathodique
j'ai finalisé la solution sans ajout de feuille
si ça t’intéresse fait moi le savoir
Cliquez pour agrandir...
Bonjour Patrick🤩

Et comment voudrais-tu que ça ne m'intéresse pas?!!!!!!!
J'ai ouvert une discussion dans ce sens, n'est-ce pas?

Au fait, j'ai testé Feuil1.UsedRange.Rows.Count et Feuil1.UsedRange.Cells(Feuil1.UsedRange.Cells.Count).Row

Le premier renvoie en réalité le nombre de lignes et le second renvoie bien la dernière ligne utilisé (plutôt cellule). Merci beaucoup.

J'attends avec impatience ta solution.

Bon dimanche.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
ok
dans cet exemple j'ai bordurer en rouge au meme endroit que les sauts de pages pour le visuel
tu a donc dans un module la methode si tu utilise une imprimante pdf avec possibilité de cumul dans un meme pdf

et dans l'autre module un procédé par reconstruction puis export en pdf et nettoyage pour revenir à l'initial

vue du résultat dans le pdf
demo8.gif



c'est possible d'avoir ton fichier même sans données juste les cellules bordurée ou au moins la feuille pour que te te fasse les adaptations pour le pagesetup
dans mon exemple elle ont été faitespar le menu mise en page dans excel
 

Pièces jointes

  • imprim cathodique.xlsm
    31.6 KB · Affichages: 18
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
et pour que tu puisse te l'adapter plus facilement je variabilise les choses qui changent pendant l’exécution entre les deux lignes pointillées
VB: 
Option Explicit
Sub testx()
    Dim dl&, dl2&, dl3&, i&, a&, c As Range, nbpages&, tbsheet(), sh, debut, rg As Range, entete As Range, col1$, col2$, chemin$
    Application.DisplayAlerts = False
    debut = 5    'ici la ligne du debut à imprimer
    With Feuil1
        dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row    'Là on est sur!!!!
        dl2 = dl + 5    'on collera les tableaux(pages copiées) à partir de cette ligne
        dl3 = dl2    'pour garder en memoire la premiere ligne de ce qui sera vraiment imprimé
        '-------------------------------------------------------------
        Set entete = .[A1:K4]    'determine l'entete
        col1 = "A" 'premiere colonne du tableau en lettre
        col2 = "K" 'derniere colonne du tableau en lettre
        chemin = ThisWorkbook.Path & "\" & "Test.pdf"
        '-------------------------------------------------------------
        For i = 5 To dl    'redim preserve dans un array des plagesséparées par un saut de ligne
            If .Rows(i).PageBreak <> xlNone Then
                If i - 1 > debut Then
                    a = a + 1
                    ReDim Preserve tbsheet(1 To a): tbsheet(a) = .Range(col1 & debut & ":" & col2 & i - 1).Address(0, 0)
                    debut = i
                End If
            End If
        Next
        a = a + 1: ReDim Preserve tbsheet(1 To a): tbsheet(a) = .Range(col1 & debut & ":" & col2 & dl).Address(0, 0)

        MsgBox "juste pour voir " & vbCrLf & Join(tbsheet, vbCrLf)    ' à supprimer

        'controle des sauts de page résiduel en dessous du tableau original
        nbpages = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
        For i = a + 1 To nbpages
            On Error Resume Next
            ActiveSheet.HPageBreaks(i).Delete
        Next

        'reconstruction des tableaux avec entete en dessous de l'original
        For i = LBound(tbsheet) To UBound(tbsheet)
            If i < UBound(tbsheet) Then Set c = Union(entete, .Range(tbsheet(i))) Else Set c = .Range(tbsheet(i))
            c.Copy .Range(col1 & dl2)
            dl2 = .UsedRange.Cells(.UsedRange.Cells.Count).Row   'Là on est sur!!!!
            If i < UBound(tbsheet) Then ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=.UsedRange.Cells(.UsedRange.Cells.Count)
        Next
        'si on veut simplement imprimer
        'on imprime les pages reconstruite
        '.Range(.Range("A" & dl3), .UsedRange.Cells(.UsedRange.Cells.Count)).PrintPreview    'ou printout sur ton imprimante pdf

        Set rg = .Range(.Range(col1 & dl3), .UsedRange.Cells(.UsedRange.Cells.Count))    'ça c'est la plage des tableaux reconstruits
        'export pdf
        rg.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               OpenAfterPublish:=False
        Set rg = Nothing


        'et enfin on supprime les pages reconstruites pour revenir à l'original
        .Range(.Range(col1 & dl3), Range(col2 & Rows.Count)).EntireRow.Delete Shift:=xlUp
    End With
End Sub
là pour le coup je peux pas faire mieux ;)
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
patricktoulon à dit:
re
et pour que tu puisse te l'adapter plus facilement je variabilise les choses qui changent pendant l’exécution entre les deux lignes pointillées
VB: 
Option Explicit
Sub testx()
    Dim dl&, dl2&, dl3&, i&, a&, c As Range, nbpages&, tbsheet(), sh, debut, rg As Range, entete As Range, col1$, col2$, chemin$
    Application.DisplayAlerts = False
    debut = 5    'ici la ligne du debut à imprimer
    With Feuil1
        dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row    'Là on est sur!!!!
        dl2 = dl + 5    'on collera les tableaux(pages copiées) à partir de cette ligne
        dl3 = dl2    'pour garder en memoire la premiere ligne de ce qui sera vraiment imprimé
        '-------------------------------------------------------------
        Set entete = .[A1:K4]    'determine l'entete
        col1 = "A" 'premiere colonne du tableau en lettre
        col2 = "K" 'derniere colonne du tableau en lettre
        chemin = ThisWorkbook.Path & "\" & "Test.pdf"
        '-------------------------------------------------------------
        For i = 5 To dl    'redim preserve dans un array des plagesséparées par un saut de ligne
            If .Rows(i).PageBreak <> xlNone Then
                If i - 1 > debut Then
                    a = a + 1
                    ReDim Preserve tbsheet(1 To a): tbsheet(a) = .Range(col1 & debut & ":" & col2 & i - 1).Address(0, 0)
                    debut = i
                End If
            End If
        Next
        a = a + 1: ReDim Preserve tbsheet(1 To a): tbsheet(a) = .Range(col1 & debut & ":" & col2 & dl).Address(0, 0)

        MsgBox "juste pour voir " & vbCrLf & Join(tbsheet, vbCrLf)    ' à supprimer

        'controle des sauts de page résiduel en dessous du tableau original
        nbpages = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
        For i = a + 1 To nbpages
            On Error Resume Next
            ActiveSheet.HPageBreaks(i).Delete
        Next

        'reconstruction des tableaux avec entete en dessous de l'original
        For i = LBound(tbsheet) To UBound(tbsheet)
            If i < UBound(tbsheet) Then Set c = Union(entete, .Range(tbsheet(i))) Else Set c = .Range(tbsheet(i))
            c.Copy .Range(col1 & dl2)
            dl2 = .UsedRange.Cells(.UsedRange.Cells.Count).Row   'Là on est sur!!!!
            If i < UBound(tbsheet) Then ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=.UsedRange.Cells(.UsedRange.Cells.Count)
        Next
        'si on veut simplement imprimer
        'on imprime les pages reconstruite
        '.Range(.Range("A" & dl3), .UsedRange.Cells(.UsedRange.Cells.Count)).PrintPreview    'ou printout sur ton imprimante pdf

        Set rg = .Range(.Range(col1 & dl3), .UsedRange.Cells(.UsedRange.Cells.Count))    'ça c'est la plage des tableaux reconstruits
        'export pdf
        rg.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               OpenAfterPublish:=False
        Set rg = Nothing


        'et enfin on supprime les pages reconstruites pour revenir à l'original
        .Range(.Range(col1 & dl3), Range(col2 & Rows.Count)).EntireRow.Delete Shift:=xlUp
    End With
End Sub
là pour le coup je peux pas faire mieux ;)
Cliquez pour agrandir...
Bonjour PatrickToulon;),

Je te remercie pour ta pugnacité et ta persévérance. Présentement, sur ton fichier ça fonctionne bien. Pas sur le mien.
Je me suis aperçu que tu as mis des sauts de pages manuellement. Dans mon cas, les sauts de pages sont automatiquement mis pas Excel. Que je réajuste par macro, déplacer un saut de page vertical vers la droite. Ensuite, en partant du bas, je rajoute un saut de page horizontal au dessus du petit tableau en fin de page.

Tu en as beaucoup fait. Je vais essayer d'adapter tout seul et reviendrai aux nouvelles.
Je t'avoue que je n'avais pas pensé à réorganiser la feuille d'autant plus que celle-ci est alimentée par macro. Bravo pour ton imagination.

Encore merci.

Bon dimanche.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
oui c'est juste ce qui me manquait ton organisation a toi
et bien lance la sub après avoir fait ton organisation
si j'avais eu ton fichier avec les sauts de lignes je te l'aurais fait
sache tout de même qu'une page (format (A4) contient environ 25 lignes avec marge et environ 32 sans marge
si tu va plus loin en impression ajusté à 100% des sauts de lignes sont crées automatiquement et ressortirons forcement sur le pdf
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Re, PatrickToulon,

Comme convenu, je reviens aux nouvelles. Le résultat n'est pas au RDV même avec le second code.
En fait, la plage est bien reconstituée plus bas mais en gardant la plage initial et du coup la création du pdf prend toute la feuille c-à-d de la cellule A1.
J'ai lancé ta procédure à la fuite de la mienne. Mon fichier était au post#1 depuis le début .
Pas grave, merci beaucoup tu en as déjà beaucoup fait. ci-joint pdf résultat avec 1er code et 2nd code du post39.

Merci beaucoup.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour le fil

[Dans la série : Si j'étais moi]
Histoire ne pas bosser trop vite, vu le salaire qui tombe tous les mois.
Donc si j'étais moi ( ce dont je doute, surtout les mois en bre)
Je me mitonne mon petit code VBA (et si vraiment j'abuse, j'ajoute une progessbar) qui fera un export natif en PDF de toutes les pages sauf la dernière.
Puis derrière, j'enchaine avec un second code qui exporte la dernière formatée selon mes désirs les plus fous.
J'ai donc deux PDF
Ensuite avec un programme tiers, je fusionne ces deux PDF en un seul.
Bilan: j'ai bossé pas trop vite, j'ai grapillé un peu de temps
(de quoi taper la discute avec ma collègue du bureau A-127)
Et j'ai au final le PDF souhaité.
Question existentielle
Plus on bosse vite avec VBA, plus on abats de taf.
Pour autant, on n'obtient pas plus de reconnaissance de la hiérarchie, ni plus de pépètes.
Alors le VBA est-il le cheval de Troie du MEDEF?
Krasuki, sors de ce code ! ;)

[/Dans la série : Si j'étais moi]
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour Staple1600
[dans la serie je suis moi ] 😁 🤣
j'installe une imprimante virtuelle pdf (sur W10 déjà présente)
dans les paramètres de cette imprimante je coche "Ajouter au document existant"ou une expression du genre
et je lance les deux impressions
[/dans la série je suis moi ]

VB: 
' si tu utilise l'imprimante bullzip en ayant simplement coché dans les parametres de bullzip "ajouter au document existant
Sub testy()

With ActiveSheet
    'dl = .UsedRange.Rows.Count    'Attention c'est pas bon si le usedrange ne commence pas en ligne 1
    dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row    'Là on est sur!!!!
 
 
    nbpages = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
   
    'impression des pages (count-1)
    .PageSetup.PrintTitleRows = "$1:$4"
    ActiveSheet.PrintOut from:=1, To:=nbpages - 1    'On imprime tout jusqu'à l'avant dernière page

    'impression de la derniere page
    .PageSetup.PrintTitleRows = ""  'on enlève les entêtes
    ActiveSheet.PrintOut from:=nbpages, To:=nbpages    'On imprime la dernière page

End With
End Sub

méthode déjà donné en page 1;)
et pas la peine d'aller manipuler mano mano l'imprimante ,ça se fait tout seul
j'utilise plus ça que export en pdf et cela depuis plus de 10 ans déjà

des imprimantes pdf en gratuiciel il y en a a foison
Capture.JPG
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

=>patricktoulon
Certes mais comme je le disais, dans ce cas, tu sers le Grand Capital ;)
Plus tu bosseras vite, plus le pressoir se mettra en route.
Moi, je mets un peu de sable dans l'engrenage.
J'ai peut-être trop écouté Greta ;)
Et je suis en train de virer altermondialiste à l'insu de mon plein gré ;)
(dit-il sur un PC sous Windows ou tourne Office, assis sur une chaise sortie d'une usine chinoise,)
 
Vote positif 0 Vote négatif

Discussions similaires

shinozak
  • Question
XL 2016 VBA: Ne pas répéter lignes pour dernière page PDF
Réponses
0
Affichages
800
shinozak
shinozak
grisan29
  • Question
problème de mise en page
Réponses
2
Affichages
813
grisan29
grisan29
A
  • Question
VBA macro imprimer en PDF les onglets sans les nommer
Réponses
7
Affichages
2 K
Anna_2013
A
M
[REF] Wiki 1 de MichelXld (Généralités Excel)
Réponses
5
Affichages
59 K
Best1
B
M
[VBA] Gérer les impressions par VBA
Réponses
9
Affichages
84 K
cathodique
cathodique

Membres actuellement en ligne

5 membres et 63 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 107
Messages
2 085 354
Membres
102 873
dernier inscrit
yayo