XL 2010 Bouton imprimer certaines feuilles en PDF

tchi456

XLDnaute Occasionnel
Bonjour,

J'ai ce code qui fonctionne pas trop mal pour pouvoir imprimer deux feuilles spécifiques de mon fichier Excel avec un aperçu avant impression.
Je souhaiterais adapter ce code pour pouvoir inscrire la date d'impression ainsi que le texte d'une cellule spécifique devant le nom du fichier.

VB:
Sub PDF()
Sheets(Array("Diagramme", "Capacité")).Select
ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\PDF.pdf"
Sheets(1).Select
End Sub

Pouvez-vous m'aider?

Meilleures salutations,

Thierry
 
Solution
Re

@tchi456

En principe on teste d'abord :

1) le fichier joint
ET si cela fonctionne comme demandé
2) on adapte la macro à SON fichier ET si cela ne fonctionne pas
3) c'est que l'adaptation n'est pas bonne

Est-ce la fait que mes feuilles sont verrouillées par mot de passe?
BIEN SUR QUE OUI o_O

Il faut déprotéger toutes les feuilles concernées en début de macro et reprotéger toutes les feuilles concernées en fin de macro

Et avec le fichier cela donne ceci :

*Merci de ton retour

@Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour @tchi456

Sans fichier pour tester je te propose :
VB:
Sub PDF()
Sheets(Array("Diagramme", "Capacité")).Select

ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & _
Format(Date, "yyyymmdd") & [H1] & "\PDF.pdf"  'Ici cellule H1 mais à adapter
'Attention dans ta cellule H1 il ne doit pas y avoir de caractere interdit

Sheets(1).Select
End Sub

ou 2eme essai

VB:
Sub PDF()
Sheets(Array("Diagramme", "Capacité")).Select

ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & _
Format(Date, "yyyymmdd") & [H1].value & "\PDF.pdf"  'Ici cellule H1 mais à adapter
'Attention dans ta cellule H1 il ne doit pas y avoir de caractere interdit

Sheets(1).Select
End Sub

*Merci de ton retour

@Phil69970
 

Phil69970

XLDnaute Barbatruc
Re

Je crois que j'ai oublié le \ séparateur o_O

VB:
Sub PDF()
Sheets(Array("Diagramme", "Capacité")).Select

ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & _
Format(Date, "yyyy-mm-dd") & "\" & [H1] & "\PDF.pdf" 'Ici cellule H1 mais à adapter
'Attention dans ta cellule H1 il ne doit pas y avoir de caractere interdit

Sheets(1).Select
End Sub

Ceci devrait mieux fonctionner ;)


*Merci de ton retour

@Phil69970
 

tchi456

XLDnaute Occasionnel
Bonjour Phil69970,

Merci pour votre proposition mais ça me donne un message d'erreur 400 pour les 3 codes.

VB:
Sub BoutonImprimerCertainesFeuilles()
Sheets(Array("Diagramme traction", "Capacité remorquage")).Select
ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & _
Format(Date, "yyyymmdd") & " - " & [B3].Value & " - " & "\Diagramme de traction.pdf"
Sheets(1).Select
End Sub

Meilleures salutations,
Thierry
 

Phil69970

XLDnaute Barbatruc
Re

& " - " & [B3].Value & " - " & "\

NON, NON et NON

VB:
Sub BoutonImprimerCertainesFeuilles()Sheets(Array("Diagramme traction", "Capacité remorquage")).Select
ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & _
Format(Date, "yyyy-mm-dd") & "\" & [B3] & "\Diagramme de traction.pdf"

Sheets(1).Select
End Sub

*J'ai modifié légèrement le code à 12h24

Sinon 1 fichier serait le bienvenu

*Merci de ton retour

@Phil69970
 
Dernière édition:

Phil69970

XLDnaute Barbatruc
Re

Autrement tu peux déjà faire un test avec :
MsgBox ThisWorkbook.Path & "\" & Format(Date, "yyyy-mm-dd") & "\" & [B3] & "\Diagramme de traction.pdf"

Tu devrais voir le chemin de ton pdf et surtout si il y a une erreur
1644579030432.png


*Merci de ton retour

@Phil69970
 

tchi456

XLDnaute Occasionnel
Bonjour Phil69970,

Désolé pour la réponse tardive. Votre code fonctionne bien jusqu'à l'aperçu. Il me montre bien les deux feuilles que je souhaite enregistrer en PDF mais quand je ferme l'aperçu, un message d'erreur apparait.

Meilleures salutations,

Thierry
 

Phil69970

XLDnaute Barbatruc
Bonjour @tchi456

Votre code fonctionne bien jusqu'à l'aperçu. Il me montre bien les deux feuilles que je souhaite enregistrer en PDF mais quand je ferme l'aperçu, un message d'erreur apparait.
1)Quel message ? Montre le car dire j'ai un message d'erreur sans en dire plus n'aide en rien 🤔

2)Tu es sur car chez moi le fichier du post #8 fonctionne

J'ai ce message qui m'indique le nom du PDF et ou le pdf est crée qui n'est pas un message d'erreur mais juste une information.

1645085104635.png


Et si je regarde à l’endroit indiqué :

1645085373863.png


Il y a bien le fichier excel ET le PDF

Donc merci d'en dire plus ......

*Merci de ton retour

@Phil69970
 

Phil69970

XLDnaute Barbatruc
Re

@tchi456

En principe on teste d'abord :

1) le fichier joint
ET si cela fonctionne comme demandé
2) on adapte la macro à SON fichier ET si cela ne fonctionne pas
3) c'est que l'adaptation n'est pas bonne

Est-ce la fait que mes feuilles sont verrouillées par mot de passe?
BIEN SUR QUE OUI o_O

Il faut déprotéger toutes les feuilles concernées en début de macro et reprotéger toutes les feuilles concernées en fin de macro

Et avec le fichier cela donne ceci :

*Merci de ton retour

@Phil69970
 

Pièces jointes

  • Impression pdf V3.xlsm
    24.5 KB · Affichages: 11
Dernière édition:

tchi456

XLDnaute Occasionnel
Re bonjour,

Votre code fonctionne parfaitement bien. Merci beaucoup pour votre aide si précieuse.
Vous avez pu constater que j'étais pas un surdoué dans ce domaine.

VB:
Sub BoutonImprimerCertainesFeuilles()

Sheets(3).Unprotect "."
Sheets(4).Unprotect "."

Sheets(Array(3, 4)).PrintPreview

With Sheets(Array(3, 4)).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Format(Date, "YYYYMMDD") & " - " & _
    "Diagramme de traction et capacité de remorquage.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

Sheets(1).Select
Sheets(3).Protect "."
Sheets(4).Protect "."
     
End Sub

Mes meilleures salutations et bonne fin de semaine!

Thierry
 

Discussions similaires