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
| '------------------------------------------------------------------------------------------------------
Public Function Rechecher_Mot_Dans_PDF(ByVal FichierPDF As String, ByVal MotCherché As String, _
ByVal RespecterCasse As Boolean, ByVal MotEntier As Boolean, _
Optional ByRef ListePages As String = "", _
Optional ByRef NbPage As Long = 0, _
Optional ByRef TotalPage) As Long
'------------------------------------------------------------------------------------------------------
' Recherche un mot dans un document PDF.
' FichierPDF : le nom complet du fichier (avec son chemin).
' MotCherché : le mot cherché.
' RespecterCasse : True s'il faut respecter la casse, False si l'on ne gère pas la casse.
' MotEntier : True s'il faut prendre la totalité du mot, False si une partie suffit.
' ListePages : ne pas renseigner, contiendra la liste des numéros de page où le mot est trouvé.
' NbPage : ne pas renseigner, contiendra le nombre de pages où le mot est trouvé.
' TotalPage : ne pas renseigner, contiendra le nombre de pages du document.
'------------------------------------------------------------------------------------------------------
' Renvoie : le nombre de fois que le mot est trouvé (donc zéro si rien n'est trouvé), ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Sources:
'https://stackoverflow.com/questions/15161209/find-certain-text-in-pdf-then-return-page-number-found-on-to-another-section-no
'https://www.developpez.net/forums/d431662-20/logiciels/microsoft-office/general-vba/contribuez/excel-word-pdf-adobe-acrobat-pro-pdfcreator-1-7-3-obsolete/
'------------------------------------------------------------------------------------------------------
Dim AcroApp As Object
Dim AcroAVDoc As Object
Dim AcroAVPage As Object
Dim AcroPDDoc As Object
Dim PageNum As Object, PageContent As Object, AcroTextSelect As Object
Dim iPage As Long
Dim sContent As String, sChar As String, Trouve As Boolean
Dim j As Long, PremPage As Long, AncPage As Long
Dim bReset As Byte
Dim AncCursor As Integer
Dim NbTrouve As Long
' Gestion des erreurs:
On Error GoTo Gest_err
Err.Clear
' Initialisation des variables:
bReset = 1
NbPage = 0
ListePages = ""
AncCursor = Application.Cursor
' Création des objets:
Set AcroApp = CreateObject("AcroExch.App")
Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
' Ouverture du fichier PDF:
Call AcroAVDoc.Open(FichierPDF, "")
' Laisse Excel au premier plan:
BringWindowToTop Application.hwnd
SetForegroundWindow Application.hwnd
' Pointe sur la première page:
Set AcroAVPage = AcroAVDoc.GetAVPageView()
AcroAVPage.Goto 0
' Renseigne le nombre de pages du document:
Set AcroPDDoc = AcroAVDoc.GetPDDoc
TotalPage = AcroPDDoc.GetNumPages
' Si le document est valide:
If AcroAVDoc.IsValid = True Then
' Curseur en mode attente:
Application.Cursor = xlWait
' Premiere recherche:
If AcroAVDoc.FindText(MotCherché, RespecterCasse, MotEntier, bReset) = True Then
' Identification de la page concernée:
iPage = AcroAVPage.GetPageNum
' Compte le nombre de pages:
NbPage = 1
' Et mémorise le numéro de la page de la première solution trouvée:
PremPage = iPage
AncPage = iPage
' Sélectionne la page:
Set PageNum = AcroPDDoc.AcquirePage(iPage)
Set PageContent = CreateObject("AcroExch.HiliteList")
If PageContent.Add(0, 9000) <> True Then GoTo Gest_err
Set AcroTextSelect = PageNum.CreatePageHilite(PageContent)
' Boucle sur tous les mots de la page:
For j = 0 To AcroTextSelect.GetNumText - 1
sContent = AcroTextSelect.GetText(j)
Trouve = False
' Si le mot peut éventuellement correspondre:
If InStr(1, LCase$(sContent), LCase$(MotCherché)) > 0 Then
Select Case MotEntier
Case False
' Si le mode est "Partie du mot" Et "Sans casse":
If RespecterCasse = False Then
' Il est donc trouvé:
Trouve = True
' Si le mode est "Partie du mot" Et "Avec casse":
Else
' Il faut vérifier avec la casse:
If InStr(1, sContent, MotCherché) > 0 Then
Trouve = True
End If
End If
Case True
' Ne pas retenir l'éventuel espace de fin du mot:
sContent = RTrim(sContent)
' Si le mot a un ou des caractères de plus (un point, une virgule, retour ligne, etc):
If Len(sContent) > Len(MotCherché) Then
' Quel est le caractère suplémentaire:
sChar = Mid(sContent, Len(MotCherché) + 1, 1)
' S'il n'est pas une lettre ordinaire alors l'accepter:
If (sChar >= "A" And sChar <= "Z") Or (sChar >= "a" And sChar <= "z") Or Asc(sChar) > 159 Then
Trouve = False
Else
sContent = Left(sContent, Len(MotCherché))
End If
End If
' Analyse si le mot est celui recherché:
If RespecterCasse = True Then
If sContent = MotCherché Then Trouve = True
Else
If LCase$(sContent) = LCase$(MotCherché) Then Trouve = True
End If
End Select
' Si le mot a été trouvé:
If Trouve = True Then
NbTrouve = NbTrouve + 1
ListePages = ListePages & iPage + 1 & ";"
End If
End If
Next j
' Boucle sur éventuels autres mots trouvés de la page pour sortir de cette page:
For j = 2 To NbTrouve
Call AcroAVDoc.FindText(MotCherché, RespecterCasse, MotEntier, bReset)
Next j
' Boucle tant que le texte cherché est trouvé:
Do While AcroAVDoc.FindText(MotCherché, RespecterCasse, MotEntier, bReset) = True
' Identification de la page concernée:
iPage = AcroAVPage.GetPageNum
' Si elle est la première analysée alors c'est la fin du traitement :
If iPage = PremPage Or iPage < AncPage Then Exit Do
' Sinon compte nombre de mots trouvés et leur page:
NbTrouve = NbTrouve + 1
ListePages = ListePages & iPage + 1 & ";"
' Et compte le nombre de page concernée:
If iPage <> AncPage Then NbPage = NbPage + 1
AncPage = iPage
DoEvents ' Cas d'une boucle sans fin pour ouvrir l'EDI.
Loop
End If
End If
' Gestion des erreurs:
Gest_err:
' Message si erreur:
Application.Cursor = AncCursor
If Err.Number <> 0 Then
MsgBox "Erreur : " & Err.Number & vbCrLf & vbCrLf _
& "Description : " & Err.Description & vbCrLf & vbCrLf _
& "Source : " & Err.Source & vbCrLf & vbCrLf _
, vbCritical, "L'application ''Rechecher_Mot_Dans_PDF'' rencontre une erreur de traitement"
Rechecher_Mot_Dans_PDF = -1
Else
Rechecher_Mot_Dans_PDF = NbTrouve
End If
' Fermeture du document et des objets:
On Error Resume Next
AcroAVDoc.Close True
AcroApp.Exit
Set AcroApp = Nothing
Set AcroAVDoc = Nothing
Set AcroAVPage = Nothing
Set AcroPDDoc = Nothing
Set PageNum = Nothing
Set PageContent = Nothing
Set AcroTextSelect = Nothing
Err.Clear
End Function
'------------------------------------------------------------------------------------------------------ |
Recherche Mot ds un PDF
Répondre avec citation
Envoyé par laurent_ott
)?
Partager