XL 2019 Imprimer PDF avec zones différentes selon onglets

pat66 · 19 Juin 2020

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

kiki29 · 19 Juin 2020

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.

pat66 · 19 Juin 2020

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 ?

kiki29 · 19 Juin 2020

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.

Phil69970 · 20 Juin 2020

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 · 20 Juin 2020

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 · 20 Juin 2020

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

Phil69970 · 20 Juin 2020

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 · 20 Juin 2020

Salut, petit rappel :

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

Office 32 bits est recommandé pour la plupart des utilisateurs
Nous recommandons la version 32 bits d’Office pour la plupart des utilisateurs, car elle offre une plus grande compatibilité avec la plupart des autres applications, en particulier les compléments tiers. C’est la raison pour laquelle la version 32 bits d’Office est installée par défaut, même sur les systèmes d’exploitation Windows 64 bits. Sur ces systèmes, le client Office 32 bits est pris en charge en tant qu’installation Windows-32-on-Windows-64 (WOW64). WOW64 est l’émulateur x86 qui permet l’exécution de façon transparente des applications Windows 32 bits sur les systèmes Windows 64 bits. Cela permet aux utilisateurs de continuer à utiliser les contrôles ActiveX et les compléments COM Microsoft avec la version 32 bits d’Office.

pat66 · 20 Juin 2020

Bonjour à tous

Kiki, merci pour l'info, dès que l'occasion se présentera, je réinstallerai la version 32 bits

Phil c'est top !! merci de ta générosité

belle journée à tous

pat66 · 2 Juillet 2020

Phil69970 à dit:

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

pat66 · 2 Juillet 2020

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 · 2 Juillet 2020

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 · 2 Juillet 2020

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 · 2 Juillet 2020

Patrick, le forum

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

Tu as écris :

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

J'ai écris :

Phil69970 à dit:

VB:

' ......

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[/B]

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

'.......

Philippe

Effectuez une recherche sur Excel Downloads...

XL 2019 Imprimer PDF avec zones différentes selon onglets

pat66

XLDnaute Impliqué

Phil69970

kiki29

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

kiki29

XLDnaute Barbatruc

Pièces jointes

Phil69970

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

Phil69970

XLDnaute Barbatruc

kiki29

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

Phil69970

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

Phil69970

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums