Impression de fichier en pdf avec macro VBA

Version imprimable

13/01/2013, 10h30
modus57

Impression de fichier en pdf avec macro VBA

Bonjour à tous :)

J’utilise pour imprimer la page active au format PDF le code de kiki29 qui a fait l’objet d’une autre discussion.

Voilà la question :
Si on utilise la fonction Excel =>imprimer=> choix de l’imprimante PDF CREATOR=>imprimer=>enregistrer, si le fichier PDF existe le message demande si il faut remplacer le fichier PDF existant.

Comment intégrer ce choix dans le code de kiki29

J’ai cherché sur plusieurs forums je n’ai pas trouvé de solution.

Merci d’avance pour votre réponse.

Bonjour,

Pour vérifier l'existence d'un fichier, utilise et adapte le code suivant :

Code:

1
2
3
4
5
6
7
8
9
    Dim FSO As Object, Chemin As String, Fich As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Chemin = "c:\temp"
    Fich = "test.pdf"
    If FSO.FileExists(Chemin & "\" & Fich) = True Then
        MsgBox "le fichier existe"
    Else
        MsgBox "le fichier n'existe pas"
    End If

oubien :

Code:

1
2
3
4
5
    Dim Chemin As String, Fich As String
    Chemin = "c:\temp"
    Fich = "test.pdf"
    rep = Dir(Chemin & "\" & Fich)
    If rep = "" Then MsgBox "le fichier n'existe pas"

Salut à vous,

Pour ma part je ne créer plus de PDF avec pdfCreator, car selon les version installé ça ne fonctionne pas tjrs bien. Je les créer directement avec excel mais pour les imprimer directement je ne sais pas ou alors la on donne par défaut l'imprimante PDFcreator:

Code:

1
2
3
4
Sheets("Feuil1").Select
  Application.ActivePrinter = "PDFCreator sur Ne00:"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
        "PDFCreator sur Ne00:", Collate:=True

Sinon pour éviter le message d'erreur:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Dim pdfjob
Dim NomExcel, NomPdf, DefaultPrinter
 Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ThisWorkbook.Name
NomPdf = "Fxxxxx"  & ".pdf"
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Impossible d'initialiser PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
GoTo eRReur
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = ThisWorkbook.Path ' chemin enregistrement du classeur actuel
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
 
'ThisWorkbook.PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'imprime le classeur entier
ThisWorkbook.Sheets("FeuilFact").PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'imprime l'onglet pour mise en page définir la partie à imprimer
'Selection.PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'imprime la selection
 
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

Voila, ma participation!

Bonjour jijie, Daniel.C :ccool:

J'ai combiné vos code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Dim pdfjob
Dim NomExcel, NomPdf, DefaultPrinter
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
Dim Chemin As String, Fich As String, rep
Chemin = "c:\temp"
Fich = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Name) & ".pdf"
rep = Dir(Chemin & "\" & Fich)
 
If rep = "" Then
    MsgBox "le fichier n'existe pas création du fichier PDFCreator"
Impression:
    With pdfjob
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Impossible d'initialiser PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
            'GoTo Error
            Exit Sub
        End If
            .cOption("UseAutosave") = 1
            .cOption("UseAutisaveDirectory") = 1
            .cOption("AutosaveDirectory") = Chemin ' chemin enregistrement du classeur actuel
            .cOption("AutosaveFilename") = Fich
            .cOption("AutosaveFormat") = 0
            .cClearCache
    End With
 
    'ThisWorkbook.PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'imprime le classeur entier
    ThisWorkbook.Sheets("Feuil1").PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'imprime l'onglet pour mise en page définir la partie à imprimer
    'Selection.PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'imprime la selection
 
    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
 
Else
    réponse = MsgBox("le fichier existe voulez-vous le remplacer ?", vbYesNo)
    If réponse = vbYes Then
        MsgBox "Remplacement du fichier existant"
        GoTo Impression
    Else
        MsgBox "Sortie de la procédure"
    End If
End If

Çà fonctionne nickel chrome, merci à vous.

Faite moi part de vos commentaires svp.

16/01/2013, 08h18
Invité

Bonjour

Pourquoi utiliser PDF CREATOR ?

Excel 2010 gère les PDF.

Philippe

Bonjour Philippe JOCHMANS ;)

Effectivement c'est plus simple de gérer les PDF par Excel 2010.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Dim Chemin As String, Fich As String, Rep As String, CheminComplet As String
 
Chemin = "c:\temp"
Fich = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name)
CheminComplet = Chemin & "\" & Fich & ".pdf"
Rep = Dir(Chemin & "\" & Fich & ".pdf")
 
If Rep = "" Then
    réponse = MsgBox("Le fichier n'existe pas, création du fichier PDFCreator", vbYesNo)
    If réponse = vbYes Then
Impression:
        ChDir Chemin
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Rep, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False 'n'affiche pas le fichier PDF
    Else
        MsgBox "Sortie de la procédure"
        Exit Sub
    End If
Else
    Réponse1 = MsgBox("le fichier existe voulez-vous le remplacer ?", vbYesNo)
    If Réponse1 = vbYes Then
        MsgBox "Remplacement du fichier existant"
        GoTo Impression
    Else
        MsgBox "Sortie de la procédure"
    End If
End If

Merci à vous pour votre aide.

17/01/2013, 17h47
patricktoulon

heu

bonjour
je rejoins l'opinion de philippe jochmans depuis 2007 l'impression en pdf fait parti des mises a jour disponibles pour office

au plaisir
11/06/2015, 12h21
xav105

Bon, ça fait plus de 2 ans que la conversation est clôturée mais je tenais à dire merci car elle vient de m'aider pour la création du PDF