Fusion de plusieurs fichiers pdf à partir liste excel

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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

Bonjour,

Voila qui devrait répondre a tes attentes

Code:

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

14/03/2013, 11h40
aude_alti

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?
14/03/2013, 11h48
Guiiand

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.
14/03/2013, 12h16
aude_alti

Guiiand, oui en effet, j'ai bien un premier fichier Fusion1.pdf :ccool:, 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

Re

voici la modif pour les noms des Pdf.

Code:

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.

14/03/2013, 14h08
aude_alti

Merci Guiiand.
Cela fonctionne bien pour le nom du fichier :ccool:

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:

oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
14/03/2013, 14h15
Guiiand

Re,

essaye en déplacant la ligne

Code:

bFirst = True

juste après la ligne

Code:

While iLigne < LastRow

Cela devrait regler to probleme, si tel n'est pas le cas, je crois que je vais commencer à secher ^^
14/03/2013, 15h50
aude_alti

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

Ce problème est résolu! ;)
28/03/2013, 18h25
aude_alti

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:

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:

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?
29/03/2013, 09h27
Guiiand

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:

sheets("Nom de la Feuille")

En espérant avoir été clair, chose dont je ne suis pas sur :)
29/03/2013, 09h43
aude_alti

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:

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!

Citation:

Envoyé par aude_alti

Donc je dois mettre :

Code:

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:

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

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:

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:

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!

Citation:

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...

29/03/2013, 11h28
Guiiand

1 pièce(s) jointe(s)

Re,

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

Code:

NomGenerique = "Dossier1, Dossier2, Dossier3, Dossier4"

j'ai pourtant précisé dans mon code

Code:

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

Donc dans ton exemple, c'est juste

Code:

NomGenerique = "Dossier"

En ce qui concerne le nom de la feuille, fais tu bien la différence entre nom et code ?
29/03/2013, 11h56
aude_alti

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

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!

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

Code:

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

29/03/2013, 16h35
aude_alti

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.

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:

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 ?

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:

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!

Voir 40 message(s) de cette discussion en une page