Discussion :

[timtim0]

Bonjour,

J'ai pour objectif de fusionner plusieurs documents PDF à partir de leurs liens contenu dans un tableau Excel. Pour se faire, je me suis inspiré de plusieurs codes que j'ai bricolés entre eux.
Mon soucis est qu'il y a bien un PDF créé (PDF Fusion) mais le contenu de ce PDF change à chaque fois que j'exécute le code.

Par exemple, je dois coller 4 documents A, B, C et D :
J'exécute une première fois, j'obtiens un document ABD
Une seconde : ACDB
Une troisième : DBAC
...

Si quelqu'un pouvait m'aider à régler ce problème ou trouver sa provenance, j'en serait très reconnaissant.
Merci
Je travail avec Excel 2007 et PDFCreator

Voici à quoi ressemble le tableau:

	A	B	...	I
1	...	...		C:\...\A.pdf
2	...	...		C:\...\B.pdf
3	...	...		C:\...\C.pdf
4	...	...		C:\...\D.pdf

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
Option Explicit
 
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
   Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String _
    , ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
 
Public Sub ImprimeTousPDF(PDFName As String, PDFLocation As String)
    Dim PDFCreator1 As PDFCreator.clsPDFCreator
    Dim DefaultPrinter As String                  ' Imprimante par Défaut (mémorisation)
    Dim c As Long                                 ' compteur Temporisation
    Dim OutputFilename As String                  ' Nom du Fichier Généré
 
 
    Set PDFCreator1 = New clsPDFCreator
    With PDFCreator1
       .cStart "/NoProcessingAtStartup"
       .cOption("UseAutosave") = 1
       .cOption("UseAutosaveDirectory") = 1
       .cOption("AutosaveDirectory") = PDFLocation    ' Répertoire de stockage du Fichier PDF généré
       Debug.Print PDFName                            ' Remplace par des _ les caractères interdits
       .cOption("AutosaveFilename") = PDFName         ' Nom de Fichier = <nom du Fichier>
       .cOption("AutosaveFormat") = 0                 ' 0 = PDF
       DefaultPrinter = .cDefaultPrinter              ' Mémorise l'Imprimante pas défaut
       .cDefaultPrinter = "PDFCreator"                ' écrase par PDFCreator
       .cClearCache
    End With
 
 
    Dim x As Long
    Dim ligne As Integer  
 
    For ligne = 2 To 5
    x = FindWindow("XLMAIN", Application.Caption)
    ShellExecute x, "print", Sheets(2).Range("I" & ligne).Value, "", "", 1
    Next ligne
 
 
    Do Until PDFCreator1.cCountOfPrintjobs = Application.Sheets.Count        ' Attend la Fin du travail pour quitter
       DoEvents
       Sleep 1000
    Loop
    Sleep 1000
    PDFCreator1.cCombineAll
    Sleep 1000
    PDFCreator1.cPrinterStop = False
 
    c = 0                                                    ' Attend la Fin d'Ecriture
    Do While (PDFCreator1.cOutputFilename = "") And (c < 50) ' au besoin 50x200ms (1 sec)
       c = c + 1
       Sleep 200
    Loop
    OutputFilename = PDFCreator1.cOutputFilename             ' Récupère le nom du Fichier Généré
    With PDFCreator1
       .cDefaultPrinter = DefaultPrinter                     ' Réattribue l'Imprimante initiale
       Sleep 200                                             ' Tempo de prise en compte avant fermeture
       .cClose
    End With
    Sleep 2000                                               ' Tempo 2 sec permettant d'assurer la libération de PDFCreator de la Mémoire
    If OutputFilename = "" Then
       MsgBox "Création Fichier pdf." & vbCrLf & vbCrLf & _
          "Une Erreur s'est produite: Délai dépassé!", vbExclamation + vbSystemModal
    End If
End Sub
 
Public Sub Petit_Test()
 
   ' Imprime la page de tous les onglets dans un seul document
   Call ImprimeTousPDF("PDF_Fusion", "C:\Essais")
      MsgBox "Fusion Terminée" & vbCrLf & vbCrLf & _
         "Fichiers PDF générés dans C:\Essais", vbExclamation + vbSystemModal
End Sub

[kiki29]

Salut, pour Modifier l'ordre dans la queue d'impression puis fusionner le tout en un seul PDF
sinon voir plutôt Fusion des PDF d'un Dossier en l'adaptant à ton contexte.

Bref bestialement qqch dans ce genre, avec MergePDFFiles_2, sans gestion d'erreurs.

Infos sur les paramètres de cette procédure :

MergePDFFiles_2 ( _
ByRef sourceFilenames As Object(), _
destinationFilename As String, _
filenamesAsBookmarks As Boolean )

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
Option Explicit
 
Sub Fusion_PDF()
Dim Tableau() As Variant
Dim Pdf As Object
Dim i As Long, j As Long
 
    Erase Tableau
    For i = 2 To 5
        ReDim Preserve Tableau(j)
        Tableau(j) = HLink2Path(Feuil1.Range("I" & i))
        j = j + 1
    Next i
 
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    Pdf.MergePDFFiles_2 Tableau, ThisWorkbook.Path & "\" & "Fusion.pdf", True
    Set Pdf = Nothing
End Sub
 
Private Function HLink2Path(rng As Range) As String
    If rng.Hyperlinks.Count > 0 Then HLink2Path = rng.Hyperlinks(1).Address
End Function

Après il y a plus alambiqué ici

[timtim0]

Génial!! Ca fonctionne
Merci beaucoup