VBA/Excel : bouton impression PDF et nom de fichier sur cellule

Il faut avoir PDFCreator pour pouvoir créer un pdf avec Excel 2003

Insérer un UserForm et mettre un CommandButton

Voici le code

Option Explicit
Private Sub CommandButton1_Click()
ToPdf
End Sub
Sub ToPdf()
Dim pdfjob As Object
Dim DefaultPrinter
Dim chemsave As String
chemsave = "C:\Users\Daniel\Documents\Nouveau dossier\" ' mettre ton chemin avec \ à la fin
If chemsave = "" Then Exit Sub
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = chemsave 'chemin destination
.cOption("AutosaveFilename") = ActiveSheet.Range("B12").Value & ".pdf" 'nom du fichier
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator" 'on imprime la feuille active
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
Dim Ret As Variant
MsgBox "Votre PDF se trouve à cet emplacement: " & chemsave, vbInformation, "Convertir en PDF"
End Sub

Si tu veux faire une boucle sur toutes les feuilles de ton classeur et les convertir,

Voici le code:

Option Explicit
Dim chemsave As String
Private Sub CommandButton1_Click()
Dim Ws As Worksheet
    'Boucle sur les feuilles du classeur.
    For Each Ws In ThisWorkbook.Worksheets
       Ws.Select
       ToPdf
       Next Ws
MsgBox "Vos PDF se trouvent à cet emplacement: " & chemsave, vbInformation, "Convertir en PDF"
End Sub
Sub ToPdf()
Dim pdfjob As Object
Dim DefaultPrinter

chemsave = "C:\Users\Daniel\Documents" ' mettre ton chemin suivi de \ à la fin
If chemsave = "" Then Exit Sub
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = chemsave 'chemin destination
.cOption("AutosaveFilename") = ActiveSheet.Range("B12").Value & ".pdf" 'nom du fichier pdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator" 'on imprime la feuille active
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
'MsgBox "Votre PDF se trouve à cet emplacement: " & chemsave, vbInformation, "Convertir en PDF"
End Sub

Bon WE

Bonjour,

Si tu as Office 2007 et plus, tu peux mettre ceci pour enregistrer au format pdf:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "W:\nomdelentreprise\TRANSACTIONS\Commandes\" & Range("B12").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False

Bonjour,

Je te remercie pour ta réponse.

J'ai oublié de préciser que je suis sur Excel 2003.

Ce code ne fonctionne pas...

Aurais-tu une autre astuce ?

J'ai trouvé un code qui répond presque à ma demande :

Private Sub CommandButton1_Click()
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Filename = "C:\Test" & ActiveSheet.Range("A1").Value & ".pdf"
SendKeys Filename & "{ENTER}", False
End Sub

Les problèmes sont les suivants :

- Pas de prise en compte de la cellule pour nommer le fichier PDF ;
- Pas de prise en compte du parcours pour enregistrer le fichier ;
- Plusieurs fenêtres s'ouvrent : enregistrer sous de Windows, PDF creator.

cs_Le Pivert,

Tu es un roi. C'est exactement ce code que je recherchais.

Tout fonctionne à merveille (au passage j'ai supprimé la ligne 1).

MERCI