Fusion de plusieurs fichiers pdf à partir liste excel

**aude_alti** · 14/03/2013, 11h06

Bonjour,

Ca fait plusieurs jours que je cherche mais je ne trouve pas…de plus je débute en macro VBA.
Je viens donc solliciter votre aide.

A l’aide d’une macro, je souhaiterai fusionner des fichiers pdf 4 par 4 en un fichier pdf, à partir d’une liste excel.
Soit à partir de la liste excel suivante:

patient1_pdf1.pdf
patient1_pdf2.pdf
patient1_pdf3.pdf
patient1_pdf4.pdf
patient2_pdf1.pdf
patient2_pdf2.pdf
patient2_pdf3.pdf
patient2_pdf4.pdf
patient3_pdf1.pdf
patient3_pdf2.pdf
patient3_pdf3.pdf
patient3_pdf4.pdf

J’obtiendrai patient1.pdf, patient2.pdf, patient3.pdf…etc. avec patient1.pdf = fusion de patient1_pdf1.pdf et patient1_pdf2.pdf et patient1_pdf3.pdf et patient1_pdf4.pdf
Dans l’exemple je n’ai reporté que 12 fichiers pdf à fusionner mais au final, j’en aurai environ 600.

Sur le forum, j’ai trouvé le code suivant qui permet de fusionner en 1 fichier pdf tous les fichiers de la liste excel. Il me manque donc une boucle de 4 en 4 que je ne parviens pas à insérer.

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
Option Explicit
Sub Tst_Fusion()
Dim sDossierPDF As String
Dim sDossierOut As String
Dim sFichierFusion As String
 
    sDossierPDF = ThisWorkbook.Path & "\"
    sDossierOut = ThisWorkbook.Path & "\" & "Test" & "\"
    sFichierFusion = "Fusion.pdf"
 
    FusionPDFs sDossierPDF, sDossierOut, sFichierFusion
End Sub
 
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
 
    bFirst = True
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    ' Worksheets("PATIENT").Range("A2:E2").Copy Ws.Range("A1:E1")
 
    For I = 1 To LastRow
        sFichier = Feuil1.Range("A" & I)
        If bFirst Then
            bFirst = False
            Set oPDDoc = CreateObject("AcroExch.PDDoc")
            oPDDoc.Open sPdfDir & sFichier
        Else
            Set oTempPDDoc = CreateObject("AcroExch.PDDoc")
            oTempPDDoc.Open sPdfDir & "\" & sFichier
            oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
            oTempPDDoc.Close
        End If
    Next I
 
    With oPDDoc
        .Save 1, sPdfOutDir & "\" & sFichierOut
        .Close
    End With
 
    Set oPDDoc = Nothing
    Set oTempPDDoc = Nothing
End Sub

Merci d’avance pour votre aide qui me sera très précieuse.

aude_alti

**Guiiand** · 14/03/2013, 11h20

Bonjour,

Voila qui devrait répondre a tes attentes

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
Option Explicit
Sub Tst_Fusion()
Dim sDossierPDF As String
Dim sDossierOut As String
Dim sFichierFusion As String
 
    sDossierPDF = ThisWorkbook.Path & "\"
    sDossierOut = ThisWorkbook.Path & "\" & "Test" & "\"
    sFichierFusion = "Fusion.pdf"
 
    FusionPDFs sDossierPDF, sDossierOut, sFichierFusion
End Sub
 
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
 
    bFirst = True
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    iLigne = 1
    ' Worksheets("PATIENT").Range("A2:E2").Copy Ws.Range("A1:E1")
 
 
While iLigne < LastRow
    iNoPatient = iNoPatient + 1
    For I = 0 To 3
        sFichier = Feuil1.Range("A" & iLigne + I)
        If bFirst Then
            bFirst = False
            Set oPDDoc = CreateObject("AcroExch.PDDoc")
            oPDDoc.Open sPdfDir & sFichier
        Else
            Set oTempPDDoc = CreateObject("AcroExch.PDDoc")
            oTempPDDoc.Open sPdfDir & "\" & sFichier
            oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
            oTempPDDoc.Close
        End If
    Next I
 
    iLigne = iLigne + 4
 
    With oPDDoc
        .Save 1, sPdfOutDir & "\" & Left(sFichierOut, Len(sFichierOut) - 4) & iNoPatient & ".pdf"
        .Close
    End With
 
    Set oPDDoc = Nothing
    Set oTempPDDoc = Nothing
Wend
 
End Sub

**aude_alti** · 14/03/2013, 11h40

Merci Guiiand pour ta réponse, je la teste et reviens vers toi

Par contre, une chose me chagrine, mon fichier final Fusion.pdf va être écrasé à chaque fois par le nouveau pdf créé. Il faudrai donc que je fasse une boucle avec iNoPatient?

**Guiiand** · 14/03/2013, 11h48

Regarde juste au dessous du while, iNoPatient s’incrémente a chaque boucle de 4 i.

Donc normalement, il y aura bien un pdf différent a chaque fois.

**aude_alti** · 14/03/2013, 12h16

Guiiand, oui en effet, j'ai bien un premier fichier Fusion1.pdf

, par contre ça ne marche que si j'ai 5 pdf dans ma liste, au delà ça buggue et je n'ai pas de Fusion1.pdf. Aurais-tu une idée?

Et je complique un peu la donne

, je souhaiterai que mon fichier de sorti, au lieu de s'appeler Fusion1, s'appelle 'les 9 premiers caractères' de patient1_pdf1.pdf, puis Fusion2.pdf s'appelle patient2_pdf1.pdf..etc.
(car en fait 'patient1' de fichier patient1_pdf1.pdf est une chaîne de 9 chiffres)

Merci encore à toi,

aude_alti

**Guiiand** · 14/03/2013, 13h13

Re

voici la modif pour les noms des 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
Option Explicit
Sub Tst_Fusion()
Dim sDossierPDF As String
Dim sDossierOut As String
Dim sFichierFusion As String
 
    sDossierPDF = ThisWorkbook.Path & "\"
    sDossierOut = ThisWorkbook.Path & "\" & "Test" & "\"
    sFichierFusion = "Fusion.pdf"
 
    FusionPDFs sDossierPDF, sDossierOut, sFichierFusion
End Sub
 
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
 
    bFirst = True
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    iLigne = 1
 
While iLigne < LastRow
    iNoPatient = iNoPatient + 1
    For I = 0 To 3
        sFichier = Feuil1.Range("A" & iLigne + I)
        If bFirst Then
            bFirst = False
            Set oPDDoc = CreateObject("AcroExch.PDDoc")
            oPDDoc.Open sPdfDir & sFichier
        Else
            Set oTempPDDoc = CreateObject("AcroExch.PDDoc")
            oTempPDDoc.Open sPdfDir & "\" & sFichier
            oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
            oTempPDDoc.Close
        End If
    Next I
 
    'J'ai mis iNoPatient devant pour eviter d'ecraser le patient1_pdf1.pdf original
    NomNouveauFichier = iNoPatient & Feuil1.Range("A" & iLigne)
    iLigne = iLigne + 4
 
    With oPDDoc
        .Save 1, sPdfOutDir & "\" & NomNouveauFichier
        .Close
    End With
 
    Set oPDDoc = Nothing
    Set oTempPDDoc = Nothing
Wend
 
End Sub

Par contre je ne vois pas pourquoi ca bloque à 5 pdf. pourrais tu executer la macro pas a pas et me dire qu est ce qui ne va pas ? Car la je ne vois pas.

**aude_alti** · 14/03/2013, 14h08

Merci Guiiand.
Cela fonctionne bien pour le nom du fichier

Par contre, ça ne me génère toujours q'un fichier final.

Pour l'erreur, j'ai le message : Erreur d'exécution '91' Variable d'objet ou de bloc With non définie et au niveau de l'exécution pas à pas, la ligne suivante semble poser problème:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1

**Guiiand** · 14/03/2013, 14h15

Re,

essaye en déplacant la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

bFirst = True

juste après la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

While iLigne < LastRow

Cela devrait regler to probleme, si tel n'est pas le cas, je crois que je vais commencer à secher ^^

**aude_alti** · 14/03/2013, 15h50

Guiiand, ça marche très bien! Merci beaucoup!!

Ce problème est résolu!

**aude_alti** · 28/03/2013, 18h25

J'ai de nouveau un problème avec le code ci-dessus.

Il fonctionnait très bien la semaine dernière, je l'ai relancé aujourd'hui et il plante à la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row

J'ai le message d'erreur:

Erreur de compilation, variable non définie

En effet, Feuil1 n'est pas déclarée donc je l'ai déclarée en Long, String, Integer..mais rien n'y fait, j'ai alors le message d'erreur
'Erreur de compilation Qualificateur incorrect'

J'ai aussi essayé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim Feuil1 As Worksheet

Mais j'obtiens : 'Erreur d'exécution '91' Variable objet ou variable de bloc With non définie'

De plus, il me semble que je n'ai rien modifié depuis la semaine dernière, je ne comprends pas pourquoi cette erreur est survenue ni comment la corriger?

**Guiiand** · 29/03/2013, 09h27

Bonjour,

J'ai en parti suivi la discussion que tu as eu pour la suite de ton probleme.

Est ce que Feuil1 existe encore dans ton projet ?

Car avec l'implantation des template, le déplacement des onglets ... Feuil1 a peu etre disparu.

Si c'est le cas, a toi de trouver le bon nom de feuille. Si la feuille ne change pas de nom, je te conseille la syntaxe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sheets("Nom de la Feuille")

En espérant avoir été clair, chose dont je ne suis pas sur

**aude_alti** · 29/03/2013, 09h43

Bonjour Guiiand,

Tu fais référence à l'autre post que j'ai ouvert?

En fait pour chaque post j'ai 2 classeurs différents donc ils n'ont pas de lien entre eux (pour le moment).

Ma feuille s'appelle bien 'Feuil1'...

Donc je dois mettre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sheet ("Feuil1")

? mais où?

Merci pour ton aide?

Au fait, l'auteur du code que j'ai recopié vient de kiki29. Merci à toi kiki29.

De plus, je souhaite complexifier un peu le code, mais je ne sais pas comment faire...

En fait, les 4 types de fichiers à fusionner sont dans 4 dossiers différents : dossier 'pdf1', dossier 'pdf2', dossier 'pdf3' et dossier 'pdf4'. Les 4 dossiers sont dans le même sous répertoire.

La macro actuelle fusionne un fichier pdf de 'pdf1', avec un fichier pdf de 'pdf2', avec un fichier pdf de 'pdf3', avec un fichier pdf de 'pdf4'. Puis recommence.

Pour le moment, je dois recopier tous les fichiers à fusionner dans le même dossier. Est-il possible d'améliorer cette macro de façon à ce qu'elle pointe dans chacun des 4 dossiers?

Merci d'avance pour votre aide!

**Guiiand** · 29/03/2013, 09h56

Envoyé par aude_alti

Donc je dois mettre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sheet ("Feuil1")

? mais où?

Merci pour ton aide?

attention a bien faire la différence entre le nom de la feuille (le nom apparaissant dans l'onglet), et le code de la feuille (que l'on voit uniquement en VBA)

feuil1 fais appel au code, alors que

Sheets("Nom de la feuille") fais appel au nom de la feuille/onglet.

Voici le nouveau code :

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
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("NomFeuille").Range("A" & Rows.Count).End(xlUp).Row
    'Remplcae Nomfeuille par le nom de l'onglet de la feuille
    iLigne = 1
    NomGenerique = "Nom des des sous repertoires sans l'indice" 'a toi de completer ici
    'tes sous rep doivent s'appeler quelques choses du genre Sous rep1, Sous rep2 , Sous rep 3 et Sous rep 4
 
While iLigne < LastRow
    bFirst = True
    iNoPatient = iNoPatient + 1
    For I = 0 To 3
        sFichier = Sheets("NomFeuille").Range("A" & iLigne + I)
        'Remplcae Nomfeuille par le nom de l'onglet de la feuille ici aussi
        If bFirst Then
            bFirst = False
            Set oPDDoc = CreateObject("AcroExch.PDDoc")
            oPDDoc.Open sPdfDir & NomGenerique & I + 1 & "\" & sFichier
        Else
            Set oTempPDDoc = CreateObject("AcroExch.PDDoc")
            oTempPDDoc.Open sPdfDir & NomGenerique & I + 1 & "\" & sFichier
            oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
            oTempPDDoc.Close
        End If
    Next I
 
    'J'ai mis iNoPatient devant pour eviter d'ecraser le patient1_pdf1.pdf original
    NomNouveauFichier = iNoPatient & Feuil1.Range("A" & iLigne)
    iLigne = iLigne + 4
 
    With oPDDoc
        .Save 1, sPdfOutDir & "\" & NomNouveauFichier
        .Close
    End With
 
    Set oPDDoc = Nothing
    Set oTempPDDoc = Nothing
Wend
 
End Sub

Adapte bien a ton code ou j'ai précisé des commentaires

Edit:

Ton fichier doit se trouver dans le répertoire qui contient les sous repertoire

**aude_alti** · 29/03/2013, 11h19

Merci Guiiand pour ton nouveau code. Je vais l'essayer et reviens vers toi.

Sinon, en ce qui concerne mon problème avec Feuil1, j'ai tout repris dans un nouveau classeur et ça marche...je ne vois pas d'où venait l'erreur.

Guiiand,

J'ai lancé ton code. Rien ne se passe. Pas de message d'erreur, pas de beug mais pas de fichiers pdf créés. En plus, ça va très vite, j'ai l'impression que ça tourne dans le vide.

Voici ce que donne ton code adapté à mon cas:

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
 
Sub Tst_Fusion()
Dim sDossierPDF As String
Dim sDossierOut As String
Dim sFichierFusion As String
 
    sDossierPDF = ThisWorkbook.Path & "\"
    sDossierOut = ThisWorkbook.Path & "\" & "Test" & "\"
    sFichierFusion = "Fusion.pdf"
 
    FusionPDFs sDossierPDF, sDossierOut, sFichierFusion
End Sub
 
 
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("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
    'Remplcae Nomfeuille par le nom de l'onglet de la feuille
    iLigne = 1
    NomGenerique = "Dossier1, Dossier2, Dossier3, Dossier4" 'a toi de completer ici
    'tes sous rep doivent s'appeler quelques choses du genre Sous rep1, Sous rep2 , Sous rep 3 et Sous rep 4
 
While iLigne < LastRow
    bFirst = True
    iNoPatient = iNoPatient + 1
    For I = 0 To 3
        sFichier = Sheets("Feuil1").Range("A" & iLigne + I)
        'Remplcae Nomfeuille par le nom de l'onglet de la feuille ici aussi
        If bFirst Then
            bFirst = False
            Set oPDDoc = CreateObject("AcroExch.PDDoc")
            oPDDoc.Open sPdfDir & NomGenerique & I + 1 & "\" & sFichier
        Else
            Set oTempPDDoc = CreateObject("AcroExch.PDDoc")
            oTempPDDoc.Open sPdfDir & NomGenerique & I + 1 & "\" & sFichier
            oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
            oTempPDDoc.Close
        End If
    Next I
 
    'J'ai mis iNoPatient devant pour eviter d'ecraser le patient1_pdf1.pdf original
    NomNouveauFichier = iNoPatient & Feuil1.Range("A" & iLigne) 'Remplcae Nomfeuille par le nom de l'onglet de la feuille ici aussi
    iLigne = iLigne + 4
 
    With oPDDoc
        .Save 1, sPdfOutDir & "\" & NomNouveauFichier
        .Close
    End With
 
    Set oPDDoc = Nothing
    Set oTempPDDoc = Nothing
Wend
 
End Sub

j'ai un doute sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NomGenerique = "Dossier1, Dossier2, Dossier3, Dossier4"

Est-ce que je l'ai bien complétée?

pour info, je ne suis créé un dossier test avec dedans:
--fichier excel avec le code, onglet Feuil1 avec la liste des nom de fichiers pdf
--un 'Dossier1' qui contient les fichiers pdf1
--un 'Dossier2' qui contient les fichiers pdf2
--un 'Dossier3' qui contient les fichiers pdf3
--un 'Dossier4' qui contient les fichiers pdf4
--dossier Test qui doit contenir les pdf créés

Est-ce tu vois d'où pourrai venir mon problème?

Merci à toi!

Envoyé par aude_alti

Sinon, en ce qui concerne mon problème avec Feuil1, j'ai tout repris dans un nouveau classeur et ça marche...je ne vois pas d'où venait l'erreur.

En fait, apparemment, il y a une différence entre une Feuil1 originale, créée par excel dès la création d'un nouveau classeur et une Feuil1 que je renomme en Feuil1 (par exemple, la Feuil3 que je renomme en Feuil1, car la vraie Feuil1 initiale a été supprimée). Dans le 2ème cas, le code plante et on me demande de 'qualifier' Feuil1, ce que je ne sais pas faire...

**Guiiand** · 29/03/2013, 11h28

Re,

Je me suis peut etre mal exprimé, à la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NomGenerique = "Dossier1, Dossier2, Dossier3, Dossier4"

j'ai pourtant précisé dans mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NomGenerique = "Nom des des sous repertoires sans l'indice"

Donc dans ton exemple, c'est juste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NomGenerique = "Dossier"

En ce qui concerne le nom de la feuille, fais tu bien la différence entre nom et code ?

**aude_alti** · 29/03/2013, 11h56

Guiiand, en effet c'est moi qui t'es mal lu, désolé. Avec 'Dossier' ça marche, super!

J'avais noter Dossier1, Dossier2,...etc pour l'exemple et que ce soit plus facile à comprendre. Du coup, je ne peux l'appliquer à mes vrais sous rep qui ont des noms complètement différents comme Banane, Pomme, Poire, Abricot??

Tu as aussi raison pour Feuil1, je ne fais pas bien la différence...je vais regarder ta pièce jointe.

Merci encore à toi!

**Guiiand** · 29/03/2013, 12h45

A doit d'adapter le code si dessous pour qu'il corresponde a tes besoins :

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
Sub monraccourci()
    Set scrHst = CreateObject("WScript.Shell")
    emplacement = scrHst.SpecialFolders("Desktop")
    Set raccourci = scrHst.CreateShortcut(emplacement & "\nomduraccourci.lnk")
    raccourci.WorkingDirectory = emplacement
    raccourci.TargetPath = "P:\01 - Département Technique\015 - Stage\Guillaume BRIAND\02 - Assemblage PE\"
    raccourci.Save
    Set raccourci = Nothing
    Set scrHst = Nothing
End Sub
 
Sub inter()
 
    Dim IE As New InternetExplorer
    Dim Barre As HTMLGenericElement
 
    IE.navigate ("www.google.com")
 
    IE.Visible = True
 
    Set Barre = IE.document.body.all("q")
 
    Barre.Value = "VBA"
 
    'Set IE = Nothing
 
End Sub
 
Option Explicit
Sub Tst_Fusion()
Dim sDossierPDF As String
Dim sDossierOut As String
Dim sFichierFusion As String
 
    sDossierPDF = ThisWorkbook.Path & "\"
    sDossierOut = ThisWorkbook.Path & "\" & "Test" & "\"
    sFichierFusion = "Fusion.pdf"
 
    FusionPDFs sDossierPDF, sDossierOut, sFichierFusion
End Sub
 
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("NomFeuille").Range("A" & Rows.Count).End(xlUp).Row
    'Remplcae Nomfeuille par le nom de l'onglet de la feuille
    iLigne = 1
 
While iLigne < LastRow
    bFirst = True
    iNoPatient = iNoPatient + 1
    For I = 0 To 3
        sFichier = Sheets("NomFeuille").Range("A" & iLigne + I)
        'Remplcae Nomfeuille par le nom de l'onglet de la feuille ici aussi
 
            Select Case I
                Case 0
                    NomGenerique = "Pomme"
                Case 1
                    NomGenerique = "Poire"
                Case 2
                    NomGenerique = "Banane"
                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
 
    'J'ai mis iNoPatient devant pour eviter d'ecraser le patient1_pdf1.pdf original
    NomNouveauFichier = iNoPatient & Feuil1.Range("A" & iLigne)
    iLigne = iLigne + 4
 
    With oPDDoc
        .Save 1, sPdfOutDir & "\" & NomNouveauFichier
        .Close
    End With
 
    Set oPDDoc = Nothing
    Set oTempPDDoc = Nothing
Wend
 
End Sub

**aude_alti** · 29/03/2013, 16h35

Guiiand,

Tu me confirmes que je n'ai pas besoin de Sub monraccourci() et de sub inter() ?

Je n'ai utiliser que Sub Tst_Fusion() et il le fichier PDF créé dans le rep Test ne comprend que pdf1. Apparemment, la boucle pour assembler pdf1, pdf2, pdf3 et pdf4 ne tourne pas... :-(

J'ai re-testé mais ça ne fonctionne toujours pas...
Il y a un soucis avec la boucle puisque seul le pdf1 est pris en compte.

**Guiiand** · 02/04/2013, 08h21

Bonjour,

Effectivement, monraccourci(), et inter() n'ont rien à faire là.

Pourrais -tu executer la macro pas à pas pour me dire exactement ce qu'il se passe ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
        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

est ce que ca passe que dans le premier cas, ou est ce que ca passe bien dans le else, mais ne fais pas ce qu'on lui demande ?

**aude_alti** · 02/04/2013, 14h52

Bonjour Guiiand,

Apparemment, ça passe bien dans le else....

Merci à toi pour ton aide!

Guiiand,

Ton code marche très bien.
En fait, c'est mes sous rep qui n'étaient pas notés dans l'ordre par rapport à Feuil1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
            Select Case I
                Case 0
                    NomGenerique = "Pomme"
                Case 1
                    NomGenerique = "Poire"
                Case 2
                    NomGenerique = "Banane"
                Case 3
                    NomGenerique = "Abricot"
            End Select

Merci pour ton aide!

Fusion de plusieurs fichiers pdf à partir liste excel

Macros et VBA Excel

Discussions similaires

Partager

Partager