Discussion :

[tutur17449]

Bonjour à tous,

Tout d'abord un grand merci pour la diffusion des codes VBA.

J'aurais une petite question vis à vis du code visant à fusionner les PDF d'un dossier.

Il fonctionne parfaitement, cependant j'essaye de l'intégrer dans une boucle et je n'y arrive pas vraiment ...

Ce que je cherche à réaliser c'est :
- Aller dans le dossier A, fusionner les fiches PDF en un document A
- Aller dans le dossier B, fusionner les fiches PDF en un document B

En revanche j'obtiens plutôt :
- Dossier A, fiche A,
- Dossier B, fiche AB

Je ne sais pas comment faire pour ne pas stocker en mémoire les PDF du dossier précédent ...

J’espère avoir été assez claire et merci d'avance pour les retours.



Voici ma macro:

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
 
Public Sub test()
 
 
Dim cpt As Byte
Dim j As Variant
Dim SA As Integer
Dim chemin As String
 
 
 
SA = Range("Références!S65536").End(xlUp).Row
 
cpt = 0
 
chemin = "chemin"
 
 
 For Each j In Range("Références!S1:S" & SA)
 
Dim Sec As Variant
Dim Ag As Variant
 
         cpt = cpt + 1
 
         MsgBox (cpt)
 
         Sec = Range("Références!Q" & cpt)
         MsgBox (Sec)
         Ag = Range("Références!R" & cpt)
         MsgBox (Ag)
         Range("AJ2") = Ag
 
 
        ListeFichiers chemin & Sec & "\" & Ag, True
        Fusion
 
    Next j
 
End Sub

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
Option Explicit
 
Dim Cpt As Long
Dim Tableau() As Variant
Const TypeFichier As String = "*.pdf"
 
Private Sub Fusion()
Dim Pdf As Object
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    Pdf.MergePDFFiles_2 Tableau, ThisWorkbook.Path & "\" & "Fusion Dossier.pdf", True
    Set Pdf = Nothing
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
 
Sub SelDossierFusion()
Dim sChemin As String
 
    sChemin = ThisWorkbook.Path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner un Dossier"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            Application.StatusBar = ""
            DoEvents
            Cpt = 0
            Erase Tableau
           '    ListeFichiers récursive ou non True/False
            ListeFichiers .SelectedItems(1), True
            Fusion
        End If
    End With
End Sub

[kiki29]

Salut, voir ici : Fusion des PDFs d'un dossier via PDFCreator / Excel pour le moment.

[tutur17449]

Parfait ! Cela fonctionne impec'

Merci beaucoup pour la réponse.

[PowerOfSun]

Salut, voir ici : Fusion des PDFs d'un dossier via PDFCreator / Excel pour le moment.

Bonjour kiki29,

je cherche à fusionner tous les PDF d'un dossier grâce à PDFCreator.
Les liens de votre message ne fonctionnent plus. Est-il possible de les mettre à jour ?
idem pour votre listre de contribution avec EXcel et les PDFs.

Merci beaucoup.