Excel / Word / PDF avec Adobe Acrobat Pro et PDFCreator 1.7.3 (obsolète)

**belxa** · 22/03/2016, 12h12

Bonjour Kiki29,

Je suis novice sur le forum, j'espère que je pose ma question au bon endroit.

J'ai plusieurs fichiers PDF tous construit de la même façon : un titre, plusieurs infos texte puis des tableaux.

Je souhaiterais à partir de ces fichiers extraire des informations (le titre et une ligne de texte présente dans les infos qui correspond au nombre de commentaire sur chaque fichier).
Ces informations, je voudrais les faire remonter dans un fichier excel qui formerait le tableau suivant:
Nom du fichier | Texte
Nom1 | texte1
Nom2 | texte2
.... | ....

J'utilise Acrobat Pro X. J'ai essayé avec le traitement par lot. Fichier > Assistant action. Mais je n'arrive à rien...
Peut-être est-ce plus simple d'utiliser une macro?
J'ai vu beaucoup de bouts de code dans tes précédentes réponses mais ne sais pas vraiment comment m'en servir.

J'espère que tu pourras m'aider

Merci.

**kiki29** · 22/03/2016, 13h37

Salut, tu as plusieurs exemples : Pdf2Excel et Pdf2Excel 2007+ . Il te faudra rajouter les procédures pour reformater uniquement les infos désirées et auparavant peut-être qqs pbs de tempo via la constante Tempo ( indispensable avec les sendkeys ).

Voir cette remarque pour le paramétrage du Reader : Problèmes lors de l'usage des SendKeys si Acrobat Reader 10 et +

Ces 2 fichiers m'ont permis de traiter 6700 fichiers pdf ( 1.7 Go au total, dans 3 présentations différentes ) d'une base Kompass pour en extraire autour de 638000 entreprises avec uniquement les infos utiles.

Après s'il s'agit de formulaires, mais j'en doute, donc c'est pour info il y a : Acrobat Pro Lecture de Formulaires PDF

Il y a : Liste des contributions et téléchargements qui permet de naviguer dans le bazar.

Un échantillon de un à deux fichiers pdf pourrait faciliter les choses.

**belxa** · 22/03/2016, 14h46

Merci pour cette réponse rapide.

Pour exemple, je te joins deux fichiers.

Ce sont des exemples basiques.
Le fichier N12211221 affiche les informations en première page. Sur mon fichier excel j'aimerais donc afficher : N12211221 dans la colonne "Nom du fichier" et 3 commentaires dans la colonne "Texte".

En vrai, je ne suis pas censé avoir ces infos en première page. Mais, comme dans le fichier N12211222, avoir uniquement mon tableau avec les commentaires.
Il faut donc à partir de ce fichier, compter le nombre de commentaire et mettre dans mon fichier excel : dans la colonne "Nom du fichier", N12211222 (nom du pdf) et dans la colonne "Texte", le compte du nombre de commentaire présent sur mon fichier, ici 3.

Sachant que cela doit être automatisé sur un grand nombre de fichiers.

Dans ta réponse précédente, tu n'utilises pas le batch d'AcrobatPro?

J'espère que mes explications ne sont pas trop flou.

Merci

**kiki29** · 23/03/2016, 05h30

Salut, j'ai trouvé cela ( minimaliste ) ..... mais il me retourne le double du nombre d'annotations ( sans raison apparente ), par exemple 6 pour 3 ?

P.-S.: Je viens de lire que les annotations ouvertes provoquaient une duplication des informations. Est-ce une explication ? auquel cas en ajoutant \ 2 ?

Tu crées un bouton et l'affectes à la procédure SelectFichier

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
Option Explicit
 
Private Sub LectureFichier_01(sFichier As String)
Dim PDDoc As Object
Dim PDPage As Object
Dim iNumPage As Long
Dim i As Long
Dim cpt As Long
 
    Set PDDoc = CreateObject("AcroExch.PDDoc")
 
    PDDoc.Open sFichier
    iNumPage = PDDoc.GetNumPages
    cpt = 0
    If iNumPage > 0 Then
        For i = 0 To iNumPage - 1
            Set PDPage = PDDoc.AcquirePage(i)
            cpt = cpt + PDPage.GetNumAnnots() '\ 2 ?
        Next i
        MsgBox cpt
    End If
 
    PDDoc.Close
End Sub
 
Sub SelectFichier()
Dim Fichier As Variant
    ChDrive ThisWorkbook.Path
    ChDir ThisWorkbook.Path
 
    Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    If Fichier <> False Then LectureFichier_01 (Fichier)
End Sub

Après tu prends par exemple ce fichier et tu l'adaptes à ton contexte en reportant dans la colonne C6..Cxyz les infos fournies par la procédure LectureFichier_01.

**belxa** · 23/03/2016, 14h22

Minimaliste? Je trouve déjà ça super!!!

J'ai bien affecté la procédure à mon bouton mais lorsque je clic ça m'affiche le message suivant :"Argument ou appel de procédure incorrect".
A moins que je devais changer des paramètres dans le code que tu m'as fourni... Je ne sais pas.

Merci encore, tu m'es d'une grande aide.

**graphikris** · 23/03/2016, 18h04

Bonjour Kiki29,
Je suis confrontée à un souci mineur.
J'extrais d'un fichier Excel des données pour les publier au format Pdf directement sur un site interne de mon entreprise.
Pour le publier, je l'envoie vers un serveur interne qui tourne a son maximum. Mon souci est que dès que je lance ma macro, parfois le serveur est occupé et dans ce cas je tombe sur le msg d'erreur d'Excel qui me dit : "Fin" ou "Débogage".
Comment faire pour éviter ce msg et avoir à la place : "Serveur occupé, veuillez relancer votre macro ultérieurement."

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'Publication du fichier en Pdf
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="H:\perso\Extraction referentiel documentaire.pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
 
    ActiveWorkbook.Close False
 
  rep = MsgBox("Votre extraction a été effectuée avec succès. Vous pouvez la consulter directement sur le portail interne dans la rubrique Documents.", vbYes + vbInformation, "Publication de document...")
 
End Sub

Cordialement.

**kiki29** · 24/03/2016, 08h56

Acrobat : Une version qui semble elle correcte, à tester plus à fond.

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
Option Explicit
 
Private Sub LectureFichier(sFichier As String)
Dim PDDoc As Object
Dim PDPage As Object
Dim iNumPage As Long
Dim Annot As Object
Dim i As Long, j As Long
Dim cpt As Long, iAnnots As Long
 
    Set PDDoc = CreateObject("AcroExch.PDDoc")
 
    PDDoc.Open sFichier
    iNumPage = PDDoc.GetNumPages
    cpt = 0
    If iNumPage > 0 Then
        For i = 0 To iNumPage - 1
            Set PDPage = PDDoc.AcquirePage(i)
            iAnnots = PDPage.GetNumAnnots
            For j = 0 To iAnnots - 1
                Set Annot = PDPage.GetAnnot(j)
                If (Annot.GetContents <> "" And Annot.GetSubtype <> "Popup") Then
                    cpt = cpt + 1
                End If
            Next j
        Next i
        MsgBox cpt
    End If
 
    PDDoc.Close
    Set PDDoc = Nothing
End Sub
 
Sub SelectFichier()
Dim Fichier As Variant
    ChDrive ThisWorkbook.Path
    ChDir ThisWorkbook.Path
 
    Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    If Fichier <> False Then LectureFichier (Fichier)
End Sub

**belxa** · 24/03/2016, 09h05

Bonjour Kiki,

J'avais bien créé le bouton et affecté la procédure. C'est une fois que je clic sur mon bouton que j'ai le message d'erreur :"Argument ou appel de procédure incorrect".

**graphikris** · 24/03/2016, 18h13

Envoyé par kiki29

Salut, aucune idée, n'ayant plus de serveur à disposition. Voir si en le sauvant d'abord en local sur ton pc puis ensuite en le copiant sur ton serveur cela change qqch.

Ok, je vais poser la question dans le forum "Macros et VBA"
Merci tout de meme

**kiki29** · 26/03/2016, 10h22

Acrobat : A placer dans un module standard sous Word

Appeler la procédure SelFichierPDF.

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Option Explicit
 
Sub SelFichierPDF()
Dim sChemin As String
    sChemin = ThisDocument.Path
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner le Fichier"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "PDF ", "*.pdf", 1
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Fichier"
        .Show
        If .SelectedItems.Count > 0 Then
            DoEvents
            OuvrirPDF_Page .SelectedItems(1), 1
            LireCommentaires
        End If
    End With
End Sub
 
Private Sub OuvrirPDF_Page(ByVal sFichier As String, iPage As Long)
Dim PdfApp As Object
Dim PdfDoc As Object
Dim PdfPageView As Object
 
    Set PdfApp = CreateObject("AcroExch.App")
    Set PdfDoc = CreateObject("AcroExch.AVDoc")
 
    If PdfDoc.Open(sFichier, "") Then
        PdfDoc.BringToFront
        PdfDoc.Maximize False
 
        Set PdfPageView = PdfDoc.GetAVPageView()
        With PdfPageView
            .GoTo iPage - 1
            .ZoomTo 2, 50
        End With
 
        Set PdfPageView = Nothing
    End If
 
    Set PdfDoc = Nothing
    Set PdfApp = Nothing
End Sub
 
Private Sub LireCommentaires()
Dim AcroApp As Object
Dim i As Long, j As Long
Dim NewDoc As Document
Dim NewDocRange As Range
Dim bNotes As Boolean
Dim AVDoc As Object, PDDoc As Object
Dim iPages As Long
Dim PDPage As Object
Dim bEntete As Boolean
Dim iAnnots As Long
Dim annot As Object
 
    Set AcroApp = CreateObject("AcroExch.App")
 
    If (0 < AcroApp.GetNumAVDocs) Then
        Set NewDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
        Set NewDocRange = NewDoc.Range
 
        bNotes = False
 
        Set AVDoc = AcroApp.GetActiveDoc
        Set PDDoc = AVDoc.GetPDDoc
 
        iPages = PDDoc.GetNumPages
        For i = 0 To iPages - 1
            Set PDPage = PDDoc.AcquirePage(i)
            If (Not PDPage Is Nothing) Then
                bEntete = False
                iAnnots = PDPage.GetNumAnnots
                For j = 0 To iAnnots - 1
                    Set annot = PDPage.GetAnnot(j)
                    If (annot.GetContents <> "" And annot.GetSubtype <> "Popup") Then
                        If (bEntete = False) Then
                            With NewDocRange
                                .Collapse wdCollapseEnd
                                .Text = "Page: " & (i + 1) & vbCr
                                .Bold = True
                                .ParagraphFormat.LineUnitBefore = 1
                            End With
                            bEntete = True
                        End If
                        With NewDocRange
                            .Collapse wdCollapseEnd
                            .Text = annot.GetTitle & vbCr
                            .Italic = True
                            .Font.Size = NewDocRange.Font.Size - 1
                            .ParagraphFormat.LineUnitBefore = 0.6
 
                            .Collapse wdCollapseEnd
                            .Text = annot.GetContents & vbCr
                            .Font.Size = NewDocRange.Font.Size - 2
                        End With
                        bNotes = True
                    End If
                Next j
            End If
        Next i
 
        If (Not bNotes) Then
            With NewDocRange
                .Collapse wdCollapseEnd
                .Text = "Pas de notes PDF" & vbCr
                .Bold = True
            End With
        End If
 
        AVDoc.Close True
        AcroApp.Exit
    End If
End Sub

Téléchargeable ici

**kiki29** · 31/03/2016, 08h31

@belxa : est-ce que cela t'aidera ?

**kiki29** · 01/04/2016, 10h16

Suite à un post de kimai ( resté sans réponse de sa part ) : Impression/Fusion de certains onglets d'un classeur en PDF

Cette exemple permet :

l'impression des onglets sélectionnés en PDF.
la fusion éventuelle de ces onglets sélectionnés en PDF.
De tenir compte des éventuels doublons.

Le tout sauvé dans un dossier qui se crée automatiquement au même niveau que l'appli.

Cet exemple est à adapter au contexte de l'utilisateur pour le classeur concerné.

Pour l'adapter à un classeur spécifique :

Décompresser le fichier via 7Zip
Sur la feuille Recap : tout sélectionner puis le coller dans une nouvelle feuille créée pour l'adaptation dans le classeur concerné.
Copier/coller le code dans un module standard.
Mettre à jour le CodeName de la feuille ajoutée en shRecap
Affecter le bouton Récap à la procédure Recap
Affecter le bouton PDFs à la procédure EnregistrementPDF
Lancer manuellement la procédure PosBoutons pour positionner les boutons/checkboxes

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
Option Explicit
 
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
 
Dim Ar() As String
 
Private Function CreationDossier(sDossier) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 
Private Function DecompteA() As Boolean
Dim LastRow As Long, i As Long
    DecompteA = False
    With shRecap
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 1 To LastRow
            If UCase$(.Cells(i, 2)) = "X" Then
                DecompteA = True
                Exit Function
            End If
        Next i
    End With
End Function
 
Sub EnregistrementPDF()
Dim sNomFichierPDF As String
Dim i As Long, cpt As Long, LastRow As Long
Dim FSO As Object, sNomfichier As String, sFichierPDF As String
Dim sRacine As String, sDossierPDFs As String, sNomFichierFusion As String
    sRacine = ThisWorkbook.Path
    sDossierPDFs = "Dossier PDFs"
 
    If DecompteA = False Then
        MsgBox "Taper dans la colonne B un x ou X en vis à vis" & vbCrLf & _
               "des Feuilles à exporter en PDF" & vbCrLf & _
               "Ou ..... lancer la Récap", vbInformation + vbOKOnly, "x ou X"
        Exit Sub
    End If
 
    With Application
        .ScreenUpdating = False
        .StatusBar = ""
    End With
 
    If shRecap.CheckBoxes("chkPDF").Value = 1 Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        If FSO.FolderExists(sRacine & "\" & sDossierPDFs) Then _
           FSO.DeleteFolder sRacine & "\" & sDossierPDFs, True
        Set FSO = Nothing
        shRecap.CheckBoxes("chkDoublons").Value = 0
    End If
 
    CreationDossier sRacine & "\" & sDossierPDFs
 
    LastRow = shRecap.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        If UCase$(shRecap.Cells(i, 2)) = "X" Then
            cpt = cpt + 1
            sNomFichierPDF = sRacine & "\" & sDossierPDFs & "\" & shRecap.Cells(i, 1)
 
            If shRecap.CheckBoxes("chkFusion").Value = 1 Then
                If shRecap.CheckBoxes("chkDoublons").Value = 1 Then
                    sNomFichierFusion = "Fusion.pdf"
                    sNomfichier = RenommerFichier(sRacine & "\" & sDossierPDFs, sNomFichierFusion)
                Else
                    sNomFichierFusion = sRacine & "\" & sDossierPDFs & "\" & "Fusion.pdf"
                    sNomfichier = sNomFichierFusion
                End If
 
                Application.ScreenUpdating = False
                Fusion
                Sheets(Ar).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                                Filename:=sNomfichier, _
                                                Quality:=xlQualityStandard, _
                                                IncludeDocProperties:=True, _
                                                IgnorePrintAreas:=False, _
                                                OpenAfterPublish:=False
                Application.ScreenUpdating = True
                shRecap.Select
                Exit For
            Else
                If shRecap.CheckBoxes("chkDoublons").Value = 1 Then
                    sFichierPDF = shRecap.Cells(i, 1) & ".pdf"
                    sNomfichier = RenommerFichier(sRacine & "\" & sDossierPDFs, sFichierPDF)
                Else
                    sNomfichier = sNomFichierPDF
                End If
                Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, _
                                              Filename:=sNomfichier, _
                                              Quality:=xlQualityStandard, _
                                              IncludeDocProperties:=True, _
                                              IgnorePrintAreas:=False, _
                                              OpenAfterPublish:=False
            End If
            Application.StatusBar = cpt
        End If
    Next i
 
    With shRecap
        .Activate
        .Range("C1").Select
    End With
    Application.ScreenUpdating = True
End Sub
 
Private Sub Fusion()
Dim i As Long, j As Long, LastRow As Long
    LastRow = shRecap.Range("A" & Rows.Count).End(xlUp).Row
    Erase Ar(): j = 0
    For i = 1 To LastRow
        If UCase$(shRecap.Cells(i, 2)) = "X" Then
            ReDim Preserve Ar(j)
            Ar(j) = Sheets(i).Name
            j = j + 1
        End If
    Next i
End Sub
 
Private Sub PosBoutons()
Dim T As Range
    With shRecap
        .Activate
        Set T = .Cells(2, 4)
        With .Buttons("BtnRecap")
            .Left = T.Left + 5
            .Top = T.Top
            .Width = 50
        End With
 
        With .Buttons("BtnPdf")
            .Left = shRecap.Buttons("BtnRecap").Left
            .Top = shRecap.Buttons("BtnRecap").Top + shRecap.Buttons("BtnRecap").Height + 3
            .Height = shRecap.Buttons("BtnRecap").Height
            .Width = shRecap.Buttons("BtnRecap").Width
        End With
 
        Set T = .Cells(2, 5)
        With .Shapes("chkPDF")
            .Left = T.Left
            .Top = T.Top
            .Width = 145
            .Height = shRecap.Buttons("btnPDF").Height / 2 - 10
        End With
 
        With .Shapes("chkDoublons")
            .Left = shRecap.Shapes("chkPdf").Left
            .Top = shRecap.Shapes("chkPdf").Top + shRecap.Shapes("chkPdf").Height + 2
            .Width = shRecap.Shapes("chkPdf").Width
            .Height = shRecap.Buttons("btnPDF").Height / 2 - 10
        End With
 
        With .Shapes("chkFusion")
            .Left = shRecap.Shapes("chkPdf").Left
            .Top = shRecap.Shapes("chkDoublons").Top + shRecap.Shapes("chkDoublons").Height + 2
            .Width = shRecap.Shapes("chkPdf").Width
            .Height = shRecap.Buttons("btnPDF").Height / 2 - 10
        End With
    End With
 
    Set T = Nothing
End Sub
 
Sub Recap()
Dim i As Long
    Application.ScreenUpdating = False
    shRecap.Columns("A:B").ClearContents
    For i = 1 To ThisWorkbook.Sheets.Count
        shRecap.Cells(i, 1) = Sheets(i).Name
    Next i
    shRecap.Columns("A:B").Columns.AutoFit
    Application.ScreenUpdating = True
End Sub
 
Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String
Dim sExt As String
Dim iExt As Long
Dim i As Long, Pos As Long
Dim FSO As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        Pos = InStrRev(sNomfichier, ".")
        If Pos > 0 Then
            iExt = Len(sNomfichier) - Pos + 1
            sExt = Right$(sNomfichier, iExt)
            sPre = Left$(sNomfichier, Len(sNomfichier) - iExt)
        Else
            sExt = ""
            sPre = sNomfichier
        End If
 
        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing
 
    RenommerFichier = sDossier & "\" & sNomfichier
End Function

**Sunny13** · 01/04/2016, 10h39

Bonjour

je suis cartographe et nous produisons des plans format pdf et Jpeg que nous souhaiterions assembler en un seul PDF. Complètement novice en programmation, je sais pourtant que la solution se trouve ici.

Notre architecture est la suivante

Dossier 1
carte_012.pdf

Dossier 2
Carte_012.jpeg

Le jpg doit se trouver en page 1 du pdf.

Pourriez vous m'aider ??

Merci beaucoup

**kiki29** · 01/04/2016, 10h47

Salut, pour des cas simples il y a dans ce blog des exemples de transformation de jpg en pdf ainsi que de fusion de pdf, voir Liste des contributions et téléchargements pour naviguer dans le bazar. Cela via Acrobat ( pas le Reader ) et PDFCreator 1.7.3.
Cependant dans ton cas peut-être que l'investissement dans Acrobat serait préférable ? Il existe une version téléchargeable en essai pendant 1 mois, si mes souvenirs sont exacts.

Il y a PDFArchitect qui en version gratuite permet déjà qqch.

Un ou 2 échantillons de fichiers ( non confidentiels ) avec aussi une sortie du résultat souhaité, permettraient de juger de la faisabilité de la chose.

Sinon extraits de la liste donnée plus haut :
PDFCreator Conversion dossier Jpg/Jpeg en PDFs protégés par mots de passe propriétaire/utilisateur
PDFCreator Conversion dossier Images en PDFs protégés par mots de passe propriétaire/utilisateur
PDFCreator Conversion d'images Tif Bmp Png Jpg Gif d'un dossier dans un seul PDF résultant
Acrobat : Conversion Image Tif Bmp Gif Jpg en PDF
Acrobat : Fusion de fichiers PDF
PDFCreator : Fusion des PDF d'un Dossier

**Sunny13** · 01/04/2016, 10h51

Envoyé par kiki29

Salut, pour des cas simples il y a dans ce blog des exemples de fusion de pdf ainsi que de transformation de jpg en pdf
voir Liste des contributions et téléchargements pour naviguer dans le bazar. Cela via Acrobat et PDFCreator.
Cependant dans ton cas peut-être que l'investissement dans Acrobat serait préférable ? Il existe une version téléchargeable en essai pendant 1 mois, si mes souvenirs sont exacts.

Bonjour Kiki, merci de ta réponse rapide

alors nous avons la version pro d'Acrobat reader XI, cela peut il suffire. Après je pensais éventuellement à un Jvs pour illustrator ?

**kiki29** · 01/04/2016, 18h37

Salut, inutile de fonctionner par psittacisme. Bref comme demandé plus haut : un ou 2 échantillons de fichiers ( non confidentiels ), permettraient de juger de la faisabilité de la chose.

**kiki29** · 04/04/2016, 08h55

Acrobat : Modifier les Commentaires d'un 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
Option Explicit
 
Sub ModifCommentaire()
Dim PDDoc As Object
Dim PDPage As Object
Dim Annot As Object
Dim sChemin As String, sCheminModif As String
Dim iPage As Long, iAnnots As Long
 
    sChemin = ThisWorkbook.path & "\" & "Test.pdf"
    sCheminModif = ThisWorkbook.path & "\" & "Test_mod.pdf"
 
    Set PDDoc = CreateObject("AcroExch.PDDoc")
 
    If PDDoc.Open(sChemin) Then
        iPage = PDDoc.GetNumPages
        If iPage > 0 Then
            Set PDPage = PDDoc.AcquirePage(0)
            iAnnots = PDPage.GetNumAnnots()
            If iAnnots > 0 Then
 
                Set Annot = PDPage.GetAnnot(0)
                Annot.SetContents ("Test Modification Commentaire")
                PDDoc.Save 1, sCheminModif
                PDDoc.Close
 
                Set Annot = Nothing
                Set PDPage = Nothing
                Set PDDoc = Nothing
            End If
        End If
    End If
End Sub

**Reinnobrahc** · 04/04/2016, 15h56

Bonjour,

Je souhaiterais pouvoir identifier (récupérer) via VBA le format (A4, A3, ...), ou a minima les dimensions, de chaque page d'un PDF.

Malgré mes recherches ça et là ainsi que dans la liste des contributions de cette discussion, je n'ai pas trouvé de solution. J'espère cependant qu'il en existe une, et de surcroît avec Acrobat Reader ou PDFCreator.

Merci d'avance pour vos éventuelles suggestions.

Fabien

**kiki29** · 05/04/2016, 00h10

Acrobat : Dimensions des pages d'un PDF

C'est possible via Acrobat ( pas le Reader ) les dimensions retournées x,y sont en points pour une résolution de 72 dpi.

Affecter un bouton à la procédure SelectFichier.
Changer le CodeName de la feuille recevant les infos en shInfo.

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
Option Explicit
 
Sub SelectFichier()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
 
    Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    If Fichier <> False Then Taille (Fichier)
End Sub
 
Private Function Taille(ByVal sFichier As String) As String
Dim AVDoc As Object, PDDoc As Object, PDPage As Object
Dim Rect As Object
Dim x As Long, y As Long
Dim iPage As Long, i As Long, j As Long
 
    Set AVDoc = CreateObject("AcroExch.AVDoc")
 
    If AVDoc.Open(sFichier, "") Then
        shInfo.Columns("A:C").Clear
        Application.ScreenUpdating = False
 
        Set PDDoc = AVDoc.GetPDDoc()
        iPage = PDDoc.GetNumPages: j = 1
        If iPage > 0 Then
            For i = 0 To iPage - 1
                Set PDPage = AVDoc.GetPDDoc.AcquirePage(i)
 
                Set Rect = PDPage.GetSize()
                x = Rect.x
                y = Rect.y
                Set Rect = Nothing
 
                With shInfo
                    .Cells(j, 1) = j
                    .Cells(j, 2) = x * 0.035277778 
                    .Cells(j, 3) = y * 0.035277778 
                End With
                j = j + 1
            Next i
        End If
 
        PDDoc.Close
        AVDoc.Close True
 
        Set PDPage = Nothing
        Set PDDoc = Nothing
        Set AVDoc = Nothing
 
        With shInfo
            .Columns("B:C").NumberFormat = "0.00"
            .Columns("A:C").EntireColumn.AutoFit
            .Range("D1").Select
        End With
        Application.ScreenUpdating = True
    End If
End Function

**kiki29** · 09/04/2016, 14h00

Acrobat : Ajout de Commentaires à un 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
61
62
63
64
Option Explicit
 
Sub AjoutCommentaire()
Dim PDDoc As Object
Dim Page As Object
Dim JSO As Object
Dim sChemin As String, sCheminAjout As String
Dim Point(1) As Long
Dim PopupRect(3) As Long
Dim PageRect As Object
Dim Annot As Object
Dim Props As Object
 
    sChemin = ThisWorkbook.path & "\" & "Test.pdf"
    sCheminAjout = ThisWorkbook.path & "\" & "Test_Ajout.pdf"
 
    Set PDDoc = CreateObject("AcroExch.PDDoc")
    If PDDoc.Open(sChemin) Then
        Set JSO = PDDoc.GetJSObject
        If Not JSO Is Nothing Then
            ' Taille de la 1ere page (0)
            Set Page = PDDoc.AcquirePage(0)
            Set PageRect = Page.GetSize
            ' position icône
            Point(0) = 50
            Point(1) = PageRect.y - 50
            ' coordonnées/Taille popup
            PopupRect(0) = 200
            PopupRect(1) = PageRect.y - 200
            PopupRect(2) = 300
            PopupRect(3) = PageRect.y - 400
 
            ' nouveau commentaire
            Set Annot = JSO.AddAnnot
            Set Props = Annot.getProps
            Props.Type = "Text"
            Annot.setProps Props
 
            ' remplissage champs
            Set Props = Annot.getProps
            With Props
                .Page = 0
                .Point = Point
                .PopupRect = PopupRect
                .Author = "Triboulet"
                .noteIcon = "Comment"
                .strokeColor = JSO.Color.blue
                .Contents = "Ajout depuis VBA"
            End With
            Annot.setProps Props
 
            Set Props = Nothing
            Set Annot = Nothing
            Set PageRect = Nothing
            Set Page = Nothing
            Set JSO = Nothing
        End If
        With PDDoc
            .Save 1, sCheminAjout
            .Close
        End With
    End If
    Set PDDoc = Nothing
End Sub

Téléchargement ici

Excel / Word / PDF avec Adobe Acrobat Pro et PDFCreator 1.7.3 (obsolète)

Contribuez

Discussions similaires

Partager

Partager