Discussion :

[flown720]

Bonjour à tous,

J'aurai besoin d'aide pour finir de créer mon fichier, mon fichier Excel consiste à générer plusieurs fichiers PDF à partir de données Excel générer de la façon suivante :

- 1er fichier : Dans le dossier\"Cellule A1"\"Cellule A1".pdf
- 2ème fichier : Dans le dossier\"Cellule B1"\"Cellule B1".pdf
- 3ème fichier : Dans le dossier\"Cellule C1"\"Cellule C1".pdf
etc.....

Donc, jusque là tout va bien !!! j'y suis arrivé en m'aidant de beaucoup de post

ça se complique quand je veux fusionner les fichiers pour faire un seul PDF

Dans chaque dossier "Cellule n", je mets des fichiers de tous type (ou du moins *.doc;*.pdf; *.xls ça reste les plus courants...)
et je veux fusionner le contenu de chaque dossier en 1 seul fichier PDF.

alors j'ai déjà essayé beaucoup de macro dans de nombreux postes contenant la création de pdf, avec des codes de ce type là

Code :

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

1
2
 
Set Pdf = CreateObject("pdfforge.pdf.pdf")

Et ça bloque toujours avec ce message d'erreur



Je sais pas ou ça coince, mais j'ai le même soucis, sur un pc Windows 10 ou Windows 7, avec pdf Creator installé ou non.
Alors, c'est pour ça que je fait un petit appel à l'aide.


J'espère avoir été à peu près clair, en espérant un petit coup de main de l'un d'entre vous,
Merci d'avance

[kiki29]

Salut, voir PDFCreator Fusion des PDF d'un Dossier
Pour que cela fonctionne il te faudra PDFCreator 1.7.3. Pas les versions supérieures 1.9.x et autres 2.x.

[flown720]

Oh, ça serai qu'une histoire de version de PDF Creator que j'y arrive pas !!!!
Je teste ça demain, car je sais pas si au boulot, je peux changer la version comme ça... (faudra que je vois avec les admin.)

En tout cas, merci de ta réponse et ton aide.
Je reviendrai pour comfirmer que tout est OK

Bonne soirée, et merci

[kiki29]

Déjà tu ne lis pas correctement le contenu du post.

ça ne serait qu'une histoire de version de PDF Creator

Cela je n'en sais rien , mais c'est possible. Ce qui est certain c'est qu'au delà de la version 1.7.3 l'interface VBA/Com n'est plus implémentée de la même manière ( voir ici ). Ne possédant aucun talent divinatoire pour ton code, ton installation .....

[flown720]

Bonjour,

En tout cas, tu avais vu juste sur toute la ligne, c'est bien la version de pdf Creator qui me créé cette erreur.
Je n'arrivai pas à faire fonctionner ce fichier pour fusionner les PDF :

http://www.developpez.net/forums/d15...r/#post8462166

Maintenant j'y arrive.

Par contre, j'ai pas eu le temps de travailler sur mon code, car ils m'on changé la version de PDF Creator tardivement vendredi.
Donc va falloir, que je rebosse sur le code dès lundi.

Je pense bien que je vais encore besoin d'aide, en tout cas, un grand merci

[kiki29]

Salut, supprimer : SoftwareBundler win32/stallmonitz qui s'installe avec certains téléchargements de PDFCreator 1.7.3 ( Signalé/Mis en quarantaine via Windows Defender ).

[flown720]

Salut, supprimer : SoftwareBundler win32/stallmonitz qui s'installe avec certains téléchargements de PDFCreator 1.7.3 ( Signalé/Mis en quarantaine via Windows Defender ).

Bonsoir,

donc pas eu de soucis sur ça par contre, j'ai encore besoin d'aide pour ma macro (j'ai pas mis tout le 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
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
Option Explicit
 
Sub Creation_fiche_PDF()
 
 
' Copie selection ver le tableau de génération fiche
 
    Sheets("Saisie Article").Select
    Call CREATION_DOSSIER
    Range("Tableau2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tableau articles").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
        ActiveSheet.ListObjects("Tableau1").AutoFilter.ApplyFilter
    With ActiveWorkbook.Worksheets("Tableau articles").ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Sheets("Saisie Article").Select
 
' Définition des variables dans lesquelles seront sotcké les valeurs du tableau
 
 
Dim Nom, demandeur, secteur, a, b, c, d, e, f, g,  As String
Dim Ligne_debut, Ligne_fin As Integer
Dim i As Integer
 
Ligne_debut = Range("A4").Value
Ligne_fin = Range("B4").Value
 
 
 
' Boucle incrémentale de création des articles
 
For i = Ligne_debut To Ligne_fin
 
Dim j As Integer
j = i - 1
 
 
..../......
 
 
    Dim LeNom As String, LeRep As String
 
    LeNom = Range("S1").Value
    LeRep = ThisWorkbook.Path & "\" ' chemin de la fiche article PDF dans sous-dossier
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    LeRep & LeNom & "\" & LeNom & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
 
 
    Dim Pdf As Object, Fichiers(2)
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
 
    Fichiers(0) = ThisWorkbook.Path & LeNom & "\" & LeNom & ".pdf"
    Fichiers(1) = ThisWorkbook.Path & LeNom & "\" & "Devis.pdf"
    Fichiers(2) = ThisWorkbook.Path & LeNom & "\" & "Fiche technique.pdf"
 
 
    Pdf.MergePDFFiles_2 Fichiers, ThisWorkbook.Path & "\" & LeNom & ".pdf", True
 
    Set Pdf = Nothing
 
    ActiveWorkbook.Close False
 
    Sheets(1).Select
 
 
Next
 
Sheets("Fiche de création").Visible = False
Sheets("Saisie Article").Select
Range("B2").Select
MsgBox "Fiche créée en PDF avec succès"
 
End Sub

Et ça me met la même erreur 429

et ça bloque sur cette ligne là



si quelqu'un peux m'aider, merci d'avance

[kiki29]

Salut, encore un drame du copier/coller, des déclarations absurdes de variables ( dans une boucle ! ) entre autres, select à foison, du grand n'importe quoi. Bref quand on n'a pas assimilé le B A BA, même du VBA, on aboutit à ce genre de code. Un salmigondis inepte.

Très rapidement et pas entièrement corrigé, sans aucune garantie.

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
Option Explicit
 
Sub Creation_fiche_PDF()
Dim Nom As String, demandeur As String, secteur As String
Dim a As String, b As String, c As String
Dim d As String, e As String, f As String, g As String
Dim Ligne_debut As Long, Ligne_fin As Long
Dim i As Long, j As Long
Dim LeNom As String, LeRep As String
Dim Pdf As Object, Fichiers(2)
 
    CREATION_DOSSIER
 
    Sheets("Saisie Article").Range("Tableau2").Copy
    Sheets("Tableau articles").Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                                                        False, Transpose:=True
    Application.CutCopyMode = False
 
    ActiveSheet.ListObjects("Tableau1").AutoFilter.ApplyFilter
    With ActiveWorkbook.Worksheets("Tableau articles").ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Sheets("Saisie Article").Select
 
    Ligne_debut = Range("A4").Value
    Ligne_fin = Range("B4").Value
 
    For i = Ligne_debut To Ligne_fin
        j = i - 1
 
        '..../......
 
        LeNom = Range("S1").Value
        LeRep = ThisWorkbook.Path & "\"
 
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                        LeRep & LeNom & "\" & LeNom & ".pdf", Quality:= _
                                        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                        From:=1, To:=1, OpenAfterPublish:=False
 
 
        Set Pdf = CreateObject("pdfforge.pdf.pdf")
 
        Fichiers(0) = ThisWorkbook.Path & "\" & LeNom & "\" & LeNom & ".pdf"
        Fichiers(1) = ThisWorkbook.Path & "\" & LeNom & "\" & "Devis.pdf"
        Fichiers(2) = ThisWorkbook.Path & "\" & LeNom & "\" & "Fiche technique.pdf"
 
        Pdf.MergePDFFiles_2 Fichiers, ThisWorkbook.Path & "\" & LeNom & "_fusion.pdf", True
 
        Set Pdf = Nothing
 
        ActiveWorkbook.Close False
 
        Sheets(1).Select
    Next i
 
    Sheets("Fiche de création").Visible = False
    Sheets("Saisie Article").Range("B2").Select
 
End Sub

[flown720]

Salut

Alors merci pour ces conseils, j'ai repris le code de qq'un, donc j'ai pas voulu à la base TOUT reprendre.
Et surtout que je maitrise pas du tout le basique, je l'admet fortement. c'est pour ça aussi que j'ai besoin d'aide ;-)

Alors à partir de tes conseils, j'ai pu bien avancé.

Mon erreur doit 429 doit être dû au PC que j'ai chez moi (WIN10 64 bits, excel 2010... pourtant PDF Creator 1.7.3) alors qu'à mon boulot
ça fonctionne parfaitement !!!


Par contre, j'aimerai modifié une fonctionnalité, je suis parti de ce code là :

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

Par contre, j'aimerai que le dossier soit sélectionner en auto (avec une variable) sans passer par la fenetre selection dossier (qui fonctionne très bien)
Est-ce que c'est possible? si oui comment ? merci d'avance

[kiki29]

Salut, c'est vrai, un peu dur avec la bête ..... Essaie qqch comme cela avec dans sChemin le dossier concerné ( pas testé )

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub SelDossierFusion_02()
Dim sChemin As String
 
    sChemin = "C:\Faq\Faq VBA\Exemples\PDF\Fusion PDF"
 
    Application.StatusBar = ""
    Cpt = 0
    Erase Tableau
    '    ListeFichiers récursive ou non True/False
    ListeFichiers sChemin, True
    Fusion
End Sub

[flown720]

Alors là un grand MERCI ça Marche au top

Par contre, j'ai pas compris comment il gère l'ordre des fichiers dans l'assemblage.
c'est pas un classement alphabétique, ni de création??

Est-ce que tu peux m'éclairer sur l'ordre dont ils les assemblent?

[kiki29]

Salut, si l'ordre a une importance il te faut passer par Fusion des PDFs d'un dossier via PDFCreator / Excel et agir par macro ou manuellement pour l'ordre voulu ( tri alphabétique, par date de création etc )
voir FAQ