Discussion :

[Sardaukar82]

Bonjour,

Je travaille sur un outil qui doit, à partir d'une liste Excel, rechercher si le texte de chaque cellule est présent dans le fichier PDF.
J'utilise la méthode citée mais j'aimerais que la recherche ne s'applique que sur les mots entiers.
Malgré l'argument WholeWords = 1 passé en paramètre, les résultats ne sont pas probants.
Je voulais savoir s'il s'agit d'une erreur de programmation (suis encore novice) et comment je puis régler le problème.
Je joins mes fichiers de travail

Merci d'avance

[QUOTE=kiki29;6072478]Rechercher un mot dans un fichier PDF via Acrobat

Ajouter un bouton et l'affecter à la procédure SelFichier

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 SelFichier()
Dim Fichier As Variant
Dim sMot As String
 
    ChDir ThisWorkbook.Path
 
    ' Mot à rechercher
    sMot = "Investments"
 
    Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    If Fichier <> False Then AcrobatFindText Fichier, sMot
End Sub
 
Private Sub AcrobatFindText(ByVal sFichier As String, ByVal sRch As String)
Dim oApp As Object
Dim oAvDoc As Object
Dim iTrouvé As Integer
 
    Set oApp = CreateObject("AcroExch.App")
    oApp.Hide
 
    Set oAvDoc = CreateObject("AcroExch.AVDoc")
 
    If oAvDoc.Open(sFichier, "") Then
        If Len(sRch) > 0 Then
            '   Parametres FindText
            '       StringToSearchFor ,
            '       caseSensitive (1 Or 0),
            '       WholeWords(1 Or 0),
            '       ResetSearchToBeginOfDocument (1 Or 0)
 
            '   Rencoie -1 si Trouvé, 0 autrement
            iTrouvé = oAvDoc.FindText(sRch, True, False, True)
        Else
            oAvDoc.Close (1)
            Set oAvDoc = Nothing
            Set oApp = Nothing
            Exit Sub
        End If
    End If
 
    oApp.Show
    oAvDoc.BringToFront
 
    Set oAvDoc = Nothing
    Set oApp = Nothing
End Sub

[kiki29]

Salut, regarde Acrobat Reader : Recherche dans tous les PDFs d'un dossier via Acrobat Reader (via APIs) ou Adobe Acrobat Reader DC (version 15)

A adapter à ton contexte.

[kiki29]

Salut, voir avec ceci qui semblerait fonctionner correctement ( à 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
42
43
Option Explicit
 
Sub SearchWholeWords()
Dim sMot As String
Dim i As Long
Dim fichierPdf As Variant
Dim wbListe As Workbook
Dim pathListe As String
Dim wsListe As Worksheet
Dim oApp As Object
Dim oAvDoc As Object
Dim LastRow As Long
 
    ChDir ThisWorkbook.Path
 
    fichierPdf = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    pathListe = Application.GetOpenFilename("Fichier XLS (*.xls), *.xls")
 
    Set wbListe = Workbooks.Open(pathListe)
    Set wsListe = wbListe.Sheets(1)
    LastRow = wsListe.Range("A" & Rows.Count).End(xlUp).Row
 
    Set oApp = CreateObject("AcroExch.App")
    oApp.Hide
    Set oAvDoc = CreateObject("AcroExch.AVDoc")
 
    If oAvDoc.Open(fichierPdf, "") Then
        With wsListe
            For i = 1 To LastRow
                sMot = wsListe.Range("A" & i)
                If sMot <> "" Then
                    If oAvDoc.FindText(sMot, 0, 1, 1) = -1 Then wsListe.Range("A" & i).Interior.ColorIndex = 36
                End If
                Application.StatusBar = i & " / " & LastRow
            Next i
        End With
    End If
 
    Set oAvDoc = Nothing
    Set oApp = Nothing
    Set wbListe = Nothing
    Set wsListe = Nothing
End Sub

[ingft]

Salut, regarde plutôt les liens du post 175

Salut,

J'ai bien regardé les liens et les codes dans le fichier "AAreaderDC_Rech" , mais je ne vois pas de méthode qui permet d'encadrer un mot, ou de localiser dans l'espace du pdf un mot...
je tiens à précisé que je n'ai pas pu faire marcher le code ( j'ai pu uniquement le lire )

[kiki29]

Salut, extrait pour AReader_RechAv.xls.

Fichier testé sous Windows 7 (Excel 2007 et 2010 64 bits) et Windows 8 (Excel 2007) avec Adobe Reader 10 et 11.

Chez moi sur W 10 Acro 11 / W XP Acro 6

en PJ via AReader_RechAv.xls : Recherche du terme "fonction" dans les fichiers du dossier C:\FAQ\faq VBA\Exemples, soit 22 documents contenant 327 résultats

Sinon pour JavaScript voir le code source ( extrait de la doc Adobe ) ainsi qu'ici. Donc à toi de voir avec JavaScript .....

[ingft]

Salut, Merci pour les informations !

c'est génialissime ! si j'ai bien compris la macro, on peut lire un code Javascript avec du vba ! c'est trop fort !
le code qui encadre fonctionne très bien, après pour obtenir ce que je veux il va falloir que j'apprenne le javascript alors !

Encore merci !

[kiki29]

Salut, oui c'est à craindre et dans ce cas fais des recherches sur : JavaScript for Acrobat API Reference et Developing Acrobat Applications Using JavaScript entre autres.

[Crevette54]

Bonsoir Kiki,

merci beaucoup pour tout ton travail.

J'utilise le remplissage automatique de formulaire pdf via Access grâce à ton code (plus simple que celui de fredclo trouvé avant cette discussion).

Je dois créer un formulaire écrit et lu automatiquement mais le tarif d'acrobat pro reste un frein pour qui je dois le faire donc je voulais savoir s'il y avait un autre moyen de lire / écrire un formulaire pdf "gratuitement" !!

Merci par avance pour ta réponse.

JG

[kiki29]

Salut, eh bien non, donc la meilleure solution reste Acrobat ( 420 € ) sinon sur ce forum PDF. Voir avec PHP et les librairies attenantes.
Resterait à faire des recherches sur le net
Création de Formulaires PDF via LibreOffice ( gratuit )

[Crevette54]

Merci pour ta rapide réponse.

Je y pensais bien mais je voulais en être sur.

Bon courage.

JG

[kiki29]

Acrobat Visualisation d'un PDF à la page x

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
Option Explicit
 
Sub SelFichierPDF()
Dim Fichier As Variant
Dim iPage As Long
 
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf")
    If Fichier = False Then Exit Sub
    DoEvents
    iPage = 1
    OuvrirPDF_Page Fichier, iPage
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
 
            '   0 : NoVary
            '   1 : FitPage
            '   2 : FitWidth
            '   3 : FitHeight
            '   4 : FitVisibleWidth
            '   5 : Preferred
 
            .ZoomTo 2, 150
        End With
 
        Set PdfPageView = Nothing
    End If
 
    Set PdfDoc = Nothing
    Set PdfApp = Nothing
 
End Sub

[graphikris]

Bonjour Kiki29,
J'ai parcouru tous tes posts concernant les Pdf sous toutes ses formes mais je n'ai pas pu ou peut être su trouver quelque chose pour solutionner mon petit souci.

A partir d'un fichier Excel, j'ai créé une macro qui me permet de créer un nouveau fichier Excel dans lequel j'extrait de mon fichier maître une partie des données d'une de ces feuilles.
Tout se déroule bien jusqu'à l'enregistrement de mon fichier en pdf (je passe par Excel - Fichier enregistrer en Pdf).

Je voudrais que ma macro puisse enregistrer en Pdf,sans l'intervention de celui qui la déclenche, la feuille du second classeur. Il ne faut pas qu'Acrobat demande le nom du fichier a enregistrer, ainsi que le chemin de l'enregistrement. Ca doit toujours etre le meme : (H:\perso\Extraction referentiel documentaire.pdf). A l'enregistrement le nouveau fichier créé doit écraser l'ancien sans qu'Acrobat le demande (le fichier existe deja voulez vous le remplacer ?)

J'ai trouvé quelque chose qui l'enregistre dans le bon disque et repertoire (ligne 201 de mon code) mais au final, j'obtiens un fichier de pres de 20Mo alors qu'il ne devrait pesait que 500ko. De plus ce fichier ne peut pas s'ouvrir avec Adobe Reader.

Voici mon 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
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
Sub Recherche_Doc_Pdf()
 
rep = MsgBox("Extraction de la liste des documents à jour pour mise en ligne sur le portail.", vbYes + vbInformation, "Extraction automatique...")
 
    Dim nom As String
    Dim Wbk As Workbook
    Set Wbk = Workbooks.Add
 
Windows("Base de données.xlsm").Activate
Sheets("Suivi Referentiel documentaire").Select
    ActiveSheet.Unprotect
    ActiveSheet.Range("$A$1:$K$600").AutoFilter Field:=5, Criteria1:="<>"
    Columns("A:E").Select
    Selection.Copy
    Wbk.Activate
    ActiveSheet.Paste
    Columns("A:E").EntireColumn.AutoFit
    ActiveWindow.ScrollRow = 1
    Rows("2:513").EntireRow.AutoFit
    Range("A1").Select
    Windows("Base de données.xlsm").Activate
    ActiveSheet.Range("$A$1:$K$600").AutoFilter Field:=5
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
    Sheets("Requetes").Select
    Wbk.Activate
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.RowHeight = 45
    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:E1").Select
    ActiveCell.FormulaR1C1 = "Liste du référentiel documentaire"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Extraction du"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("B3").Select
    Columns("A:A").EntireColumn.AutoFit
    Range("A2:B2").Select
    Selection.Font.Bold = True
    Selection.Font.Italic = True
    Range("B2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Range("A2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
    End With
    Range("A1:E1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 22
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 10
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
 
             '---------------------Nom du fichier à sauvegarder
    Fichier = ThisWorkbook.Path & "\Extraction referentiel documentaire" & ".pdf"
 
'c'est ici que ça bug (fichier trop lourd et illisible)
    Fichier = "H:\perso" & "\Extraction referentiel documentaire" & ".pdf"
 
        'Sauvegarde de l'extraction
         ActiveWorkbook.SaveAs Fichier
    ActiveWindow.Close
 
End Sub

Merci

[kiki29]

Salut, via l'enregistreur de macros, tu obtiens un code minimaliste de ce genre pour la feuille sélectionnée :

Code :

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

1
2
3
4
5
6
7
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="C:\Users\kiki\Desktop\Forum\Classeur1.pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False

et pour le classeur entier :

Code :

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

1
2
3
4
5
6
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
                                       Filename:="C:\Users\kiki\Desktop\Forum\Classeur2.pdf", _
                                       Quality:=xlQualityStandard, _
                                       IncludeDocProperties:=True, _
                                       IgnorePrintAreas:=False, _
                                       OpenAfterPublish:=False

[graphikris]

Bjr et merci Kiki29
j'ai mis ton 1er code en remplacement du mien a partir de la ligne 193 mais cette fois ci la mise en page est inexistante, j'obtiens 31 pages au lieu de 6.
Dans ma macro j'avais obligé Excel à mettre en forme à une page en largeur et X pages en hauteur avant de créer le pdf.

Dans ta copie ecran tout comme la mienne, il n'est pas possible de faire cette MEF

Comment dois je faire pour forcer cette MEF ?

Merci

[kiki29]

Re, La mise en page se fait toujours avant l'impression ce qui est logique et ton cas ( apparemment ). Difficile de juger sans le fichier.

[graphikris]

Bonjour kiki29,

Ma mise en page se fait a partir de la ligne 147 dans mon code, pour le bien il faudrait que la mise en page se fasse de cette manière :
- Portait
- A4
- 1 page en largeur
- Pied de page (à droite) : Page x / y

Merci pour ton aide Kiki29
Cordialement

[graphikris]

Re, au mieux j'arrive à ça ( pas jojo )

ton fichier Z est corrompu, je ne peux pas l'ouvrir.
peux tu le reposter sans zip ou compression ,
Merci

[kiki29]

Salut, compressé avec 7Zip

[graphikris]

Je le sais qu'il a ete compressé avec 7zip mais il est corrompu. Je ne peux toujours pas l'ouvrir.
Mais ce n'est pas grave car j'ai trouvé comment faire cette mise en page
Cordialement et encore merci
@+ Kiki29

[kiki29]

je viens de le télécharger puis dézipper à l'instant pour vérif, aucun problème. Je le supprime pour ne pas encombrer.