Bonjour,

J'ai trouvé sur le forum un script (de kiki29) que j'ai un peu personnalisé avec l'aide de Guiiand. Ce script permet de fusionner des fichiers pdf 4 par 4 en 1 seul fichier pdf. Les fichiers pdf proviennent des dossiers 'Pomme', 'Poire', 'Abricot' et 'Banane'.

J'ai donc:
Pomme1.pdf + Poire1.pdf + Abricot1.pdf + Banane1.pdf = pdf1
Pomme2.pdf + Poire2.pdf + Abricot2.pdf + Banane2.pdf = pdf2

...etc

PommeN.pdf + PoireN.pdf + AbricotN.pdf + BananeN.pdf = pdfN


Je voudrai :

Insérer 4 signets dans le fichier pdf final.
Ces signets seraient 'Pomme', 'Poire', 'Abricot' et 'Banane'.
Est-il possible d'insérer la création des signets directement dans ma macro fusion?

Voici le srcipt actuel:

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
 
Private Sub FusionPDFs(sPdfDir As String, _
                       sPdfOutDir As String, _
                       sFichierOut As String)
Dim bFirst As Boolean
Dim oPDDoc As Object
Dim oTempPDDoc As Object
Dim LastRow As Long
Dim I As Long
Dim sFichier As String
Dim iLigne As Integer
Dim iNoPatient As Integer
Dim NomNouveauFichier As String
Dim NomGenerique As String
 
    LastRow = Sheets("Sheet n°1").Range("A" & Rows.Count).End(xlUp).Row
    iLigne = 1
 
While iLigne < LastRow
    bFirst = True
    iNoPatient = iNoPatient + 1
    For I = 0 To 3
        sFichier = Sheets("Sheet n°1").Range("A" & iLigne + I)
 
            Select Case I
                Case 0
                    NomGenerique = "Banane"
                Case 1
                    NomGenerique = "Pomme"
                Case 2
                    NomGenerique = "Poire"
                Case 3
                    NomGenerique = "Abricot"
            End Select
 
        If bFirst Then
            bFirst = False
            Set oPDDoc = CreateObject("AcroExch.PDDoc")
            oPDDoc.Open sPdfDir & NomGenerique & "\" & sFichier
        Else
            Set oTempPDDoc = CreateObject("AcroExch.PDDoc")
            oTempPDDoc.Open sPdfDir & NomGenerique & "\" & sFichier
            oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
            oTempPDDoc.Close
        End If
    Next I
 
    NomNouveauFichier = Feuil1.Range("A" & iLigne)
    iLigne = iLigne + 4
 
    With oPDDoc
        .Save 1, sPdfOutDir & "\" & NomNouveauFichier
        .Close
    End With
 
    Set oPDDoc = Nothing
    Set oTempPDDoc = Nothing
Wend
MsgBox ("Les fichiers pdf ont été créés dans .....")
 
End Sub
Merci encore pour votre aide!