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
|
Option Explicit
Dim Cpt As Long
Dim Tableau() As Variant
Const TypeFichier As String = "*.pdf"
Private Sub Fusion(nomFinal As String)
Dim PDF As Object
Set PDF = CreateObject("pdfforge.pdf.pdf")
PDF.MergePDFFiles_2 Tableau, ThisWorkbook.Path & "\PDF\" & nomFinal & ".pdf", True
Set PDF = Nothing
End Sub
Sub FusionRepertoirePdf(nomFinal As String)
Dim sChemin As String
Cpt = 0
Erase Tableau
sChemin = ThisWorkbook.Path & "\TEMP_PDF\"
ListeFichiers sChemin, True
Fusion (nomFinal)
End Sub
Private Sub ListeFichiers(ByVal sChemin As String, ByVal Recursif As Boolean)
Dim FSO As Object
Dim dossier As Object
Dim SousDossier As Object
Dim Fichier As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set dossier = FSO.GetFolder(sChemin)
For Each Fichier In dossier.Files
If UCase(Fichier.Name) Like UCase(TypeFichier) Then
ReDim Preserve Tableau(Cpt)
Tableau(Cpt) = Fichier.Path
Cpt = Cpt + 1
Application.StatusBar = Cpt
End If
Next Fichier
If Recursif Then
For Each SousDossier In dossier.subfolders
ListeFichiers SousDossier.Path, True
Next SousDossier
End If
Set dossier = Nothing
Set FSO = Nothing
End Sub |
