Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Imprimer PDF avec zones différentes selon onglets

pat66

XLDnaute Impliqué
Bonjour à tous
Mon problème est que je n'arrive pas à écrire correctement cette macro pour qu'elle imprime les feuilles désignées avec des zones d'impression différentes

j'ai bien pensé à y intégrer ceci , mais cà ne fonctionne pas :
ActiveSheet.PageSetup.PrintArea = "$A$1:$M$27" ou Worksheets("Feuil1").PageSetup.PrintArea = "$A$1:$C$5"

mon souhait est de pouvoir imprimer en PDF les zones suivantes :
Feuil 1 = A1:M27
Feuil 2 : A5: R10
Feuil3 : A4:S20

je vous remercie de votre aide




'Private Sub PDF_Click()
' Dim Mdp As String
' Mdp = Application.InputBox("Veuillez introduire votre mot de passe")
' If Mdp <> "13050" Then MsgBox "Accès refusé !": Exit Sub
' Application.EnableEvents = False
' Dim sRep As String
' Dim sFilename As String
' If Sheets("Feuil1").Range("G27") = "" Then
' If MsgBox("Vous devez préciser le nom du client !", vbOKOnly + vbInformation, "Excel vous informe") = vbAbort Then Exit Sub
' Else
' ChDir ThisWorkbook.Path
' Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Select
' sRep = ThisWorkbook.Path
' sFilename = ThisWorkbook.Name
' sFilename = Left(sFilename, InStr(1, sFilename, ".")) & "pdf"
'
' ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:= _
' Sheets("Feuil1").Range("G27"), Quality:=xlQualityStandard, _
' IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'
' If OutputFilename = "" Then
' MsgBox "La Création du fichier PDF est terminée."
' End If
' End If
'
' Application.EnableEvents = True
'End Sub
 
Solution
Bonjour Patrick, Kiki, le forum

Je te propose ce message :

VB:
'.................

If Sh1.Range("G27") = "" Then MsgBox "Vous devez préciser le nom du client !", vbCritical, "Excel vous informe": Exit Sub

Sheets(Array(Sh1.Name, Sh2.Name, Sh3.Name)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Sh1.Range("G27"), IgnorePrintAreas:=False

'   Le message de fin que je te propose mais tu peux mettre ce que tu veux !

MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & ThisWorkbook.Path & "\" & vbCrLf & vbCrLf & _
"Sous le nom : " & Sh1.Range("G27") & ".pdf", 48, "Enregistrement fichier en PDF ..."

'

Set Sh1 = Nothing               'Decharge la feuille 1
Set Sh2 = Nothing...

kiki29

XLDnaute Barbatruc
Salut, en adaptant à ton contexte va voir ici , sinon il y a aussi ceci à la fin du post#1 : Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant
Cela suppose que la mise en page pour chaque feuille soit faite avant l'impression en pdf.
A toi d'œuvrer.
 

Pièces jointes

  • A utiliser pour formatage du code STP.png
    556 bytes · Affichages: 26
  • 1.png
    12.3 KB · Affichages: 21
  • 2.png
    15.4 KB · Affichages: 22
  • 3.png
    2.8 KB · Affichages: 22
Dernière édition:

pat66

XLDnaute Impliqué
Bonsoir Kiki29, si je demande de l'aide c'est que j'en ai besoin et je te remercie de bien vouloir m'aider, mais je n'ai pas tes compétences alors je ne comprends pas ta solution et encore moins le formatage du code

Ma demande est claire, ma macro ci dessus fonctionne très bien, je souhaite simplement pouvoir définir les zones d'impression sur les feuilles exporter en PDF, sachant que chacune de ces feuilles a une zone d'impression différente, est ce possible ou alors faut il envisager une solution plus complexe comme tu propose mais qui s'adresse à des connaisseurs d'excel ?
 
Dernière édition:

kiki29

XLDnaute Barbatruc
Re, à tester ( Excel 32 bits )
A toi d'adapter les 3 Mises En Page baptisées Mep_01,Mep_02 et Mep_03 dans le module mPDF à ton contexte. Si cela s'avère utile, je dispose d'une autre version sans Apis mais il faudra le faire savoir.
 

Pièces jointes

  • Impression_Onglets_PDF_03.zip
    32.7 KB · Affichages: 14
Dernière édition:

Phil69970

XLDnaute Barbatruc
Bonsoir Patrick, Kiki, le forum

Je te propose :

Code:
Sub BoutonPrintPDF()

Dim Mdp As String
Mdp = Application.InputBox("Veuillez introduire votre mot de passe")
If Mdp <> "13050" Then MsgBox "Accès refusé !": Exit Sub

Application.ScreenUpdating = False
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet

Set Sh1 = Feuil1                'A adapter si besoin en fonction du codename de la feuille 1
Set Sh2 = Feuil2                'A adapter si besoin en fonction du codename de la feuille 2
Set Sh3 = Feuil3                'A adapter si besoin en fonction du codename de la feuille 3

With Sh1.PageSetup
    .PrintArea = "A1:M27"       'Zone d'impression à adapter de la feuille 1
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    'Réglage des marges
    .LeftMargin = Application.InchesToPoints(0.1)   'Marge gauche
    .RightMargin = Application.InchesToPoints(0.1)  'Marge droite
    .TopMargin = Application.InchesToPoints(0.1)    'Marge haut de page
    .BottomMargin = Application.InchesToPoints(0.1) 'Marge bas de page
'    .Orientation = xlLandscape                      'Paysage
    .Orientation = xlPortrait                       'Portrait
End With

With Sh2.PageSetup
    .PrintArea = "A5:R10"       'Zone d'impression à adapter de la feuille 2
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    'Réglage des marges
    .LeftMargin = Application.InchesToPoints(0.1)   'Marge gauche
    .RightMargin = Application.InchesToPoints(0.1)  'Marge droite
    .TopMargin = Application.InchesToPoints(0.1)    'Marge haut de page
    .BottomMargin = Application.InchesToPoints(0.1) 'Marge bas de page
'    .Orientation = xlLandscape                      'Paysage
    .Orientation = xlPortrait                       'Portrait
End With

With Sh3.PageSetup
    .PrintArea = "A4:S20"       'Zone d'impression à adapter de la feuille 3
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    'Réglage des marges
    .LeftMargin = Application.InchesToPoints(0.1)   'Marge gauche
    .RightMargin = Application.InchesToPoints(0.1)  'Marge droite
    .TopMargin = Application.InchesToPoints(0.1)    'Marge haut de page
    .BottomMargin = Application.InchesToPoints(0.1) 'Marge bas de page
'    .Orientation = xlLandscape                      'Paysage
    .Orientation = xlPortrait                       'Portrait
End With

If Sh1.Range("G27") = "" Then MsgBox "Vous devez préciser le nom du client !", vbCritical, "Excel vous informe": Exit Sub

Sheets(Array(Sh1.Name, Sh2.Name, Sh3.Name)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Sh1.Range("G27"), IgnorePrintAreas:=False

Set Sh1 = Nothing               'Decharge la feuille 1
Set Sh2 = Nothing               'Decharge la feuille 2
Set Sh3 = Nothing               'Decharge la feuille 3

Application.ScreenUpdating = True

End Sub

Cordialement
 

pat66

XLDnaute Impliqué
Bonjour Kiki, bonjour Phil,
encore merci pour le temps que vous m'accordez

Kiki, je suis équipé de Windows et Office 64 bits donc mon problème reste entier, j'ai bien essayé en ajoutant PTR Safe, mais cela ne suffit pas apparemment, donc Statu Quo, on pourrait peut être essayer ta version sans Apis ?

Phil, j'ai testé ta macro adaptée à mes besoins et j'ai un code "erreur d'exécution 424 objet requis", sais tu d'où cela peut venir ?, sincèrement, je pense qu'en résolvant cette erreur cela devrait fonctionner

merci et belle journée à vous deux
Patrick
 

pat66

XLDnaute Impliqué
Re Bonjour

Phil ta macro fonctionne à merveille, l'erreur venait de moi car j'ai écris les noms de feuilles personnalisés alors qu'il fallait écrire ( feuil1, feuil2 etc ) comme tu me la écris plus haut
donc pour moi le problème est résolu grâce à toi

Penses tu que l'on puisse ajouter, si oui peux tu me dire comment et où ?
If OutputFilename = "" Then
' MsgBox "La Création du fichier PDF est terminée."
' End If
' End If

Un grand Merci pour ton aide et le partage de tes connaissances et une belle journée à toi

Patrick du pays Catalan
 
Dernière édition:

Phil69970

XLDnaute Barbatruc
Bonjour Patrick, Kiki, le forum

Je te propose ce message :

VB:
'.................

If Sh1.Range("G27") = "" Then MsgBox "Vous devez préciser le nom du client !", vbCritical, "Excel vous informe": Exit Sub

Sheets(Array(Sh1.Name, Sh2.Name, Sh3.Name)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Sh1.Range("G27"), IgnorePrintAreas:=False

'   Le message de fin que je te propose mais tu peux mettre ce que tu veux !

MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & ThisWorkbook.Path & "\" & vbCrLf & vbCrLf & _
"Sous le nom : " & Sh1.Range("G27") & ".pdf", 48, "Enregistrement fichier en PDF ..."

'

Set Sh1 = Nothing               'Decharge la feuille 1
Set Sh2 = Nothing               'Decharge la feuille 2
Set Sh3 = Nothing               'Decharge la feuille 3

'............

Note:
Il faut bien mettre le CodeName de la feuille tel qu'il est dans VBA et non pas le nom de l'onglet qui peux être changer par n'importe qui.
==> Set Sh1 = Feuil1 <=== CodeName de la feuille


Bonne journée
 

kiki29

XLDnaute Barbatruc
Salut, petit rappel :

Même Microsoft déconseille l'installation d'une version 64 bits d'Office.

 

pat66

XLDnaute Impliqué
 

pat66

XLDnaute Impliqué
Bonjour Phil

J'ai encore besoin de ton aide si tu veux bien

je souhaites que le pdf s'appelle Sh1.Range("G27") mais je n'arrives pas à lui demander d'ajouter le contenu de 2 autres cellules situé en Sh3 cellule F30 et F33 et la date du jour
exemple de nom de PDF : toto-1958-perpignan-date du jour

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Sh1.Range("G27"), IgnorePrintAreas:=False

Pourrais tu m'aider à compléter la macro car j'ai écris (voir ci dessous), mais cela ne fonctionne pas :
Sheets(Array(Sh1.Name, Sh2.Name, Sh3.Name)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "/" & Sh1.Range("G27") & "/" & Sh3.Range("F30") & "/" & Sh3.Range("F33"), IgnorePrintAreas:=False

MsgBox "Le PDF a été enregistré." & vbCrLf & vbCrLf & "Ici ==> " & ThisWorkbook.Path & "\" & vbCrLf & vbCrLf & _
"Sous le nom : " & Sh1.Range("G27") & "_" & Sh3.Range("F30") & "_" & Sh3.Range("F33") & ".pdf", 64, "Excel vous informe..."


un grand merci d'avance

Pat66
 

Phil69970

XLDnaute Barbatruc
Bonjour Patrick, Kiki, le forum

Si j'ai bien tout compris dans ta demande

VB:
Sheets(Array(Sh1.Name, Sh2.Name, Sh3.Name)).Select

' ......

Dim NFichier As String                                      'Nom du fichier

NFichier = Sh1.Range("G27") & "-" & Sh1.Range("F30") & "-" & Sh1.Range("F33") & Format(Date, "-dd-mm-yyyy")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & NFichier, IgnorePrintAreas:=False

MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & ThisWorkbook.Path & "\" & vbCrLf & vbCrLf & _
"Sous le nom : " & NFichier & ".pdf", 48, "Enregistrement fichier en PDF ..."

'.......

Cordialement
 

pat66

XLDnaute Impliqué
Phil,

voici ce que j'ai compris, mais hélas cela ne fonctionne pas
........

Sheets(Array(Sh1.Name, Sh2.Name, Sh3.Name).Select

Dim NFichier As String
NFichier = Sh1.Range("G27") & "-" & Sh3.Range("F30") & "-" & Sh3.Range("F33") & Format(Date, "-dd-mm-yyyy")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "-" & Sh1.Range("G27") & "-" & Sh3.Range("F30") & "-" & Sh3.Range("F33"), IgnorePrintAreas:=False

MsgBox "Le PDF a été enregistré." & vbCrLf & vbCrLf & "Ici ==> " & ThisWorkbook.Path & "-" & vbCrLf & vbCrLf & _"Sous le nom : " & Sh1.Range("G27") & "-" & Sh3.Range("F30")" & "-" & Sh3.Range("F33").pdf", 64, "Excel vous informe..."

Set Sh1 = Nothing 'Decharge la feuille 1
Set Sh2 = Nothing 'Decharge la feuille 2
Set Sh3 = Nothing 'Decharge la feuille 3

'ActiveWindow.Close
Application.ScreenUpdating = True
End Sub

merci
 

Phil69970

XLDnaute Barbatruc
Patrick, le forum

Tu n'as pas recopié ce que j'ai écris

Tu as écris :

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "-" & Sh1.Range("G27") & "-" & Sh3.Range("F30") & "-" & Sh3.Range("F33"), IgnorePrintAreas:=False

J'ai écris :



Philippe
 

Discussions similaires

Réponses
2
Affichages
658
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…