Bonjour tout le monde,

Je suis en stage dans une entreprise et on m'a donné en mission d'ecrire un programme en vba qui permettrait de fusionner 4 pdf pour ensuite les imprimer directement. On m'a conseillé d'utiliser les fonctions PDFCreator mais lorsque j'execute le programme il m'affiche en erreur "Erreur d'exécution '429' Un composant ActiveX ne peut pas créer d'objet" .

Merci de bien vouloir m'aider car je suis bloqué

Voici le code que j'ai pour l'instant:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
]Option Explicit
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Sub CreateTextfileAndPrint(sFichier As String, sContenu As String)
Dim FSO As Object, F As Object
Dim PDFCreator2 As Object
 
    Set PDFCreator2 = CreateObject("PDFCreator.clsPDFCreator")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set F = FSO.CreateTextFile(sFichier, True)
 
    F.WriteLine (sContenu)
    F.Close
    PDFCreator2.cPrintfile (sFichier)
 
    Sleep 2000
    FSO.DeleteFile (sFichier)
 
    Set F = Nothing
    Set FSO = Nothing
    Set PDFCreator2 = Nothing
End Sub
 
Sub CombinaisonJobs()
Dim PDFCreator As Object
Dim sDefaultPrinter As String, c As Long, sOut As String
Dim FSO As Object, sDossierOut As String
Const maxTime = 30    ' s
Const sleepTime = 250    ' ms
Const sNomFichier = "Ordre impression"
 
    Set PDFCreator = CreateObject("PDFCreator.clsPDFCreator")
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    sDossierOut = ThisWorkbook.Path & "\" & "Resultats PDF" & "\"
    If Not FSO.FolderExists(sDossierOut) Then FSO.CreateFolder (sDossierOut)
    Set FSO = Nothing
 
    PDFCreator.cStart "/NoProcessingAtStartup"
    With PDFCreator
        .cPrinterStop = True
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sDossierOut
        .cOption("AutosaveFilename") = sNomFichier
        sDefaultPrinter = .cDefaultprinter
        .cDefaultprinter = "PDFCreator"
        .cClearcache
 
        ' 1. page
        CreateTextfileAndPrint sDossierOut & "test1.pdf", "1"            En cours
        ' 2. page
        CreateTextfileAndPrint sDossierOut & "test2.pdf", "2"             En cours
        ' 3. page
        CreateTextfileAndPrint sDossierOut & "test3.pdf", "3"            En cours
        ' 4. page
        CreateTextfileAndPrint sDossierOut & "test4.pdf", "4"            En cours
 
        ' Attendre que tout soit dans la queue d'impression
        Sleep 2000
 
        ' Ordre des pages : 1 2 3 4
 
        .cMovePrintjobTop 3
        ' Ordre des pages : 3 1 2 4
 
        .cMovePrintjobBottom 2
        ' Ordre des pages : 3 2 4 1
 
        .cMovePrintjobDown 2
        ' Ordre des pages : 3 4 2 1
 
        .cMovePrintjobUp 2
        ' Ordre des pages : 4 3 2 1
 
        .cDeletePrintjob 1
        ' Ordre des pages : 3 2 1
 
        ' On fusionne le tout dans un seul pdf
        .cCombineAll
 
        ' On démarre l'imprimante
        .cPrinterStop = False
 
        c = 0
        Do While (.cOutputFilename = "") And (c < (maxTime * 1000 / sleepTime))
            c = c + 1
            Sleep sleepTime
        Loop
        sOut = .cOutputFilename
    End With
 
    With PDFCreator
        .cDefaultprinter = sDefaultPrinter
        Sleep 200
        .cClose
    End With
 
    Set PDFCreator = Nothing
 
    If sOut = "" Then
        MsgBox "Création du fichier PDF." & vbCrLf & vbCrLf & _
                "Une erreur s'est produite : temps écoulé !", vbExclamation + vbSystemModal
    End If
End Sub