XL 2010 Imprimer en plusieurs PDF l’onglet Excel actif à chaque saut de page

jeanmi

jeanmi

XLDnaute Occasionnel
Bonjour,

Les actions souhaitées : imprimer en PDF l’onglet actif dans plusieurs fichiers à chaque saut de page, dans un répertoire défini

J’ai essayé ce code : Ça marche bien mais il n'y a que l’onglet entier

Code: 
Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\HP\Documents\02-BON DE LIVRAISON CITERNE\"  & Sheets(1).Name & "_" & "Equipe_1" & ".pdf"

J’ai essayé ce code : ça marche bien pour mes trois sauts de page mais je ne choisis pas l’emplacement de la sauvegarde

Code: 
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate  :=True, IgnorePrintAreas:=False
ActiveWindow.SelectedSheets.PrintOut From:=2, To:=2, Copies:=1, Collate :=True, IgnorePrintAreas:=False
ActiveWindow.SelectedSheets.PrintOut From:=3, To:=3, Copies:=1, Collate :=True, IgnorePrintAreas:=False

Comment combiner les deux codes en un ou un autre code pour réaliser la fonction souhaitée ?

Merci de votre aide.

Cordialement
 
Solution
patricktoulon
re
Merci @kik29
sinon sans le pdfcreator
il y a 4 lignes a adapter a ta convenance
VB: 
Sub test()
    Dim cel As Range, i&, AddR$, tabloRange, feuille As Worksheet, chemin$, plage As Range, col&, lignefin&, partName$
    '**************************************************************
    'dans cet encart tu dois adapter  a ta convenance!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Set feuille = Sheets(1)    ' ici on determine la feuille
    Set plage = feuille.[A1:F31]    'ici on determine la plage complete  à imprimer !!!!!!!!!!!
    chemin = Environ("userprofile") & "\desktop\"    ' adapter le chemin du dossier ici <<< Attention!!!!doit toujour terminer par un "\"
    partName = "mondocument-page-"  ' ca ca sera le debut du nom des pdf  à...
Trier par date Trier par votes
jeanmi

jeanmi

XLDnaute Occasionnel
patricktoulon à dit:
tiens je suis allé jusqu'au bout de mon idée selon la plage demontrée dans mes precédents messages
VB: 
Sub test()
Dim cel As Range, i&, AddR$, tabloRange, feuille As Worksheet, chemin$
Set feuille = Sheets(1)
Set plage = feuille.[A1:F31] 'determiner la plage complete  à imprimer ici!!!
AddR = plage.Cells(1).Address(0, 0) & ":"
For i = 1 To feuille.HPageBreaks.Count
Set cel = feuille.HPageBreaks.Item(i).Location
AddR = AddR & "F" & cel.Offset(-1).Row & vbCrLf & cel.Address(0, 0) & ":"
Next i
AddR = AddR & plage.Cells(plage.Cells.Count).Address(0, 0)
tabloRange = Split(AddR, vbCrLf)
For i = LBound(tabloRange) To UBound(tabloRange)
chemin = Environ("userprofile") & "\desktop\mondocument-page-" & i & ".pdf"
feuille.Range(tabloRange(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       chemin, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next

MsgBox "Les plages " & vbCrLf & AddR & vbCrLf & "ont été imprimé en pdf sur le bureau"
End Sub
j'ai bien mes 4 pdf sur le bureau
Regarde la pièce jointe 1113968
Cliquez pour agrandir...
re bonjour,

j'ai testé est la séquence se déroule bien.
il y a juste une problème :
sur les 2 premiers fichiers, il n'y a que la partie gauche du tableau
sur le 3 eme fichier c'est OK.

On peut changer le chemin pour allé dans une autre répertoire que sur le bureau ?

cordialement
 
Vote positif 0 Vote négatif
kiki29

kiki29

XLDnaute Barbatruc
Re, via Acrobat ( pas le Reader )
VB: 
Option Explicit

Sub tst()
Dim sFichier As String, sDossier As String
Dim sPSfichier As String
Dim sPDFFichier As String
Dim oPDF As Object

    sDossier = ThisWorkbook.Path & "\"
    sFichier = sDossier & "Essai_01.ps"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
                                         PrintToFile:=True, PrToFileName:=sFichier, _
                                         Collate:=True, IgnorePrintAreas:=False
    sFichier = sDossier & "Essai_02.ps"
    ActiveWindow.SelectedSheets.PrintOut From:=2, To:=2, Copies:=1, _
                                         PrintToFile:=True, PrToFileName:=sFichier, _
                                         Collate:=True, IgnorePrintAreas:=False
    sFichier = sDossier & "Essai_03.ps"
    ActiveWindow.SelectedSheets.PrintOut From:=3, To:=3, Copies:=1, _
                                         PrintToFile:=True, PrToFileName:=sFichier, _
                                         Collate:=True, IgnorePrintAreas:=False

    Set oPDF = CreateObject("PdfDistiller.PdfDistiller")
    sPSfichier = sDossier & "Essai_01.ps"
    sPDFFichier = sDossier & "Essai_01.pdf"
    oPDF.FileToPDF sPSfichier, sPDFFichier, ""

    sPSfichier = sDossier & "Essai_02.ps"
    sPDFFichier = sDossier & "Essai_02.pdf"
    oPDF.FileToPDF sPSfichier, sPDFFichier, ""

    sPSfichier = sDossier & "Essai_03.ps"
    sPDFFichier = sDossier & "Essai_03.pdf"
    oPDF.FileToPDF sPSfichier, sPDFFichier, ""
 
    Set oPDF = Nothing
End Sub

Un exemple prenant en compte un "setting" d'Acrobat pour la génération d'un PDF du genre "Smallest File Size.joboptions", laissé en blanc ci-dessus.
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
Merci @kik29
sinon sans le pdfcreator
il y a 4 lignes a adapter a ta convenance
VB: 
Sub test()
    Dim cel As Range, i&, AddR$, tabloRange, feuille As Worksheet, chemin$, plage As Range, col&, lignefin&, partName$
    '**************************************************************
    'dans cet encart tu dois adapter  a ta convenance!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Set feuille = Sheets(1)    ' ici on determine la feuille
    Set plage = feuille.[A1:F31]    'ici on determine la plage complete  à imprimer !!!!!!!!!!!
    chemin = Environ("userprofile") & "\desktop\"    ' adapter le chemin du dossier ici <<< Attention!!!!doit toujour terminer par un "\"
    partName = "mondocument-page-"  ' ca ca sera le debut du nom des pdf  à adapter a ta convenance
    '*************************************************************
    col = plage.Cells(plage.Cells.Count).Column    ' la derniere colonne est pointée automatiquement
    AddR = plage.Cells(1).Address(0, 0) & ":"
    For i = 1 To feuille.HPageBreaks.Count
        Set cel = feuille.HPageBreaks.Item(i).Location
        lignefin = cel.Offset(-1).Row
        AddR = AddR & feuille.Cells(lignefin, col).Address(0, 0) & vbCrLf & cel.Address(0, 0) & ":"
    Next i
    AddR = AddR & plage.Cells(plage.Cells.Count).Address(0, 0)
    tabloRange = Split(AddR, vbCrLf)
    For i = LBound(tabloRange) To UBound(tabloRange)
        feuille.Range(tabloRange(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                                         chemin & partName & i & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next
    MsgBox "Les plages " & vbCrLf & AddR & vbCrLf & "ont été imprimé en pdf sur le bureau"
End Sub
je viens encore de tester ça fonctionne
 
Vote positif 0 Vote négatif
Solution
jeanmi

jeanmi

XLDnaute Occasionnel
patricktoulon à dit:
re
Merci @kik29
sinon sans le pdfcreator
il y a 4 lignes a adapter a ta convenance
VB: 
Sub test()
    Dim cel As Range, i&, AddR$, tabloRange, feuille As Worksheet, chemin$, plage As Range, col&, lignefin&, partName$
    '**************************************************************
    'dans cet encart tu dois adapter  a ta convenance!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Set feuille = Sheets(1)    ' ici on determine la feuille
    Set plage = feuille.[A1:F31]    'ici on determine la plage complete  à imprimer !!!!!!!!!!!
    chemin = Environ("userprofile") & "\desktop\"    ' adapter le chemin du dossier ici <<< Attention!!!!doit toujour terminer par un "\"
    partName = "mondocument-page-"  ' ca ca sera le debut du nom des pdf  à adapter a ta convenance
    '*************************************************************
    col = plage.Cells(plage.Cells.Count).Column    ' la derniere colonne est pointée automatiquement
    AddR = plage.Cells(1).Address(0, 0) & ":"
    For i = 1 To feuille.HPageBreaks.Count
        Set cel = feuille.HPageBreaks.Item(i).Location
        lignefin = cel.Offset(-1).Row
        AddR = AddR & feuille.Cells(lignefin, col).Address(0, 0) & vbCrLf & cel.Address(0, 0) & ":"
    Next i
    AddR = AddR & plage.Cells(plage.Cells.Count).Address(0, 0)
    tabloRange = Split(AddR, vbCrLf)
    For i = LBound(tabloRange) To UBound(tabloRange)
        feuille.Range(tabloRange(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                                         chemin & partName & i & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next
    MsgBox "Les plages " & vbCrLf & AddR & vbCrLf & "ont été imprimé en pdf sur le bureau"
End Sub
je viens encore de tester ça fonctionne
Cliquez pour agrandir...
Merci infiniment , de cette création et des explication très claire que tu m'a apportées.
Tous fonctionne nickel. félicitation.
Faut-il faire quelque chose pour clôturer un discussion résolue ?
Cordialement
 
Vote positif 0 Vote négatif
jeanmi

jeanmi

XLDnaute Occasionnel
kiki29 à dit:
Re, via Acrobat ( pas le Reader )
VB: 
Option Explicit

Sub tst()
Dim sFichier As String, sDossier As String
Dim sPSfichier As String
Dim sPDFFichier As String
Dim oPDF As Object

    sDossier = ThisWorkbook.Path & "\"
    sFichier = sDossier & "Essai_01.ps"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
                                         PrintToFile:=True, PrToFileName:=sFichier, _
                                         Collate:=True, IgnorePrintAreas:=False
    sFichier = sDossier & "Essai_02.ps"
    ActiveWindow.SelectedSheets.PrintOut From:=2, To:=2, Copies:=1, _
                                         PrintToFile:=True, PrToFileName:=sFichier, _
                                         Collate:=True, IgnorePrintAreas:=False
    sFichier = sDossier & "Essai_03.ps"
    ActiveWindow.SelectedSheets.PrintOut From:=3, To:=3, Copies:=1, _
                                         PrintToFile:=True, PrToFileName:=sFichier, _
                                         Collate:=True, IgnorePrintAreas:=False

    Set oPDF = CreateObject("PdfDistiller.PdfDistiller")
    sPSfichier = sDossier & "Essai_01.ps"
    sPDFFichier = sDossier & "Essai_01.pdf"
    oPDF.FileToPDF sPSfichier, sPDFFichier, ""

    sPSfichier = sDossier & "Essai_02.ps"
    sPDFFichier = sDossier & "Essai_02.pdf"
    oPDF.FileToPDF sPSfichier, sPDFFichier, ""

    sPSfichier = sDossier & "Essai_03.ps"
    sPDFFichier = sDossier & "Essai_03.pdf"
    oPDF.FileToPDF sPSfichier, sPDFFichier, ""
 
    Set oPDF = Nothing
End Sub

Un exemple prenant en compte un "setting" d'Acrobat pour la génération d'un PDF du genre "Smallest File Size.joboptions", laissé en blanc plus haut.
Cliquez pour agrandir...
Merci de cette implication. la solution PDF de Patrick fonctionne nickel. je testerais cette solution plus tard pour voir.
Encore merci
Cordialement
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
je viens d'essayer moi même A1:N62
en fait c'est parce que tu laisse les sut de page vertical par defaut
donc pour que ca fonctionne nickel

il te faut

  1. faire sauter (remettre a defaut les sauts de page
  2. definier la plage A1:N62 comme zone a imprimer
  3. mettre tes sauts de page horizontal ou tu veux
  4. aller dans la mise en page et cocher "adapter a 1 page sur 1"
  5. mettre le format paysage si tes plage sont plus large que haute
et voila tu aura A:N et uniquement tes saut de page horizontal de pris en compte dans le pdf
en fait c'est normal car l'export PDF exporte avec les paramétrés du pagesetup
 
Vote positif 0 Vote négatif
jeanmi

jeanmi

XLDnaute Occasionnel
patricktoulon à dit:
pour clôturer tu coche dans le message d'un des intervenants qui t'a convenu "marquer comme solution "

mais ne néglige quand même pas les réponses de @kiki29 c'est l'expert incontesté du pdfcréator
c'est toujours bon d'apprendre
Cliquez pour agrandir...
Dans tous les cas toutes les réponses sont toujours un plus, et déjà d'avoir des réponses mérite le respect de ceux qui passent du temps sur le sujet.
on coche dans j'aime ?
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
oui une seule
apres c'est pas une obligation
tiens un peu de lecture
www.excel-downloads.com

Préfixe "Résolu" et "Marquer comme solution"

Voici la nouvelle façon de faire suite à la mise à jour du 22/12/2020 : https://www.excel-downloads.com/threads/forums-aux-questions.20052158/ (obsolète suite à la mise à jour du 22/12/2020) Bonjour, Les personnes posant des questions dans le forum souhaitent souvent pouvoir indiquer que les...
www.excel-downloads.com www.excel-downloads.com
 
Vote positif 0 Vote négatif

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
390
ph.vanne
ph.vanne
M
  • Question
Microsoft 365 pb enregistrement PDF de plusieurs feuilles d'un classeur excel
2
Réponses
15
Affichages
1 K
MG_000
M
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
501
Nico2978
Nico2978
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
903
Phil69970
Phil69970
M
  • Question
Microsoft 365 Imprimer deux zones d'impression provenant de deux onglets sur une seule feuille
Réponses
5
Affichages
513
herve62
herve62
Cédric06400
  • Question
Microsoft 365 Aide mise en PDF de feuilles sélectionnées
Réponses
5
Affichages
870
kiki29
kiki29
B
  • Résolu(e)
XL 2016 Modifier ou créer une macro imprimer une sélection de zones
Réponses
5
Affichages
637
berru76
B
S
  • Question
XL 2019 Macro VBA enregistrement pdf plusieurs onglets dans un sens précis
Réponses
11
Affichages
1 K
sofmat
S
R
  • Question
Microsoft 365 Créer des fichiers PDF pour chaque personne et les envoyer à un destinataire unique
Réponses
1
Affichages
627
kiki29
kiki29
M
  • Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
426
Mika07
M

Membres actuellement en ligne

4 membres et 71 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
314 738
Messages
2 112 340
Membres
111 514
dernier inscrit
N.Jnin