Tester présence d'une chaine de caractères dans un pdf

**Kestion100** · 25/09/2018, 15h07

Bonjour, je cherche à vérifier la présence d'une chaine de caractères dans un fichier pdf (Acrobat.exe*32) à partir d'une macro Excel.

J'arrive à ouvrir le fichier à cherche et à fermer.

L'option à laquelle je pense et de copier (dans le presse papier?) le texte sélectionner dans le pdf (équivalent d'un contrôle + f) et de la coller dans une variable. Si la variable est "", la chaine n'est pas dans le pdf.

Si quelqu'un voit quelque chose, MERCI BEAUCOUP

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
Sub Tst()
Dim Fichier As Variant
Dim sMot As String
Dim FichCherch As String
Dim Tex As String
Dim Niv As Long
Dim OuC As Long
 
Tex = Range("C" & ActiveCell.Row).Value
sMot = Range("K2").Value
 
 
 
Niv = CompterMot(Range("C2").Value, "\")
 
 
OuC = InStr(Tex, Split(Tex, "\")(Niv)) - 1
 
FichCherch = Mid(Tex, 1, OuC)
 
 
 
    ChDir FichCherch
 
    Fichier = Split(Tex, "\")(Niv)
 
 
    On Error Resume Next
 
 
    AcrobatFindTexte FichCherch & "\" & Fichier, sMot
 
 
  Call Fermer_Un_Programme("Acrobat.exe")
 
 
 
 
    End Sub

Il existe certainement d'autres moyens, je suis preneur aussi.

**kiki29** · 25/09/2018, 16h44

Salut, si tu disposes d'Acrobat ( pas du Reader ), à adapter à ton contexte :

Acrobat : Rechercher un mot dans un fichier PDF
Acrobat : Recherche de Mots/Expressions dans un fichier pdf et Extraction des Pages concernées (1)
Acrobat : Recherche de Mots/Expressions dans un fichier pdf et Extraction des Pages concernées (2)

Il y en a d'autres accessibles via cette liste

**Kestion100** · 26/09/2018, 10h03

J'essaie d'adapter à mon cas mais je patauge.

Les codes:

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
Sub Tst()
Dim Fichier As Variant
Dim sMot As String
Dim FichCherch As String
Dim Tex As String
Dim Niv As Long
Dim OuC As Long
 
Tex = Range("C" & ActiveCell.Row).Value
sMot = Range("K2").Value
 
 
Niv = CompterMot(Range("C" & ActiveCell.Row).Value, "\")
 
OuC = InStr(Tex, Split(Tex, "\")(Niv)) - 1
 
FichCherch = Mid(Tex, 1, OuC)
 
 
 
    ChDir FichCherch
 
    Fichier = Split(Tex, "\")(Niv)
 
 
    On Error Resume Next
 
    AcrobatFindTexte FichCherch & "\" & Fichier, sMot
 
 
 
 
    End Sub

et:

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
Sub RechInPdf()
 
 
 
Dim AcroApp As Object, AcroAVDoc As Object, AcroPDDoc As Object, AcroTextSelect As Object
Dim PageNum As Object, PageContent As Object, sContent As String, i As Long, j As Long, k As Long, iNumPages As Long
Dim sResultat As String, sNomFichier As String, RchMotAdobePdf As String
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
 
sNomFichier = Range("C1").Value
 
    If AcroAVDoc.Open(sNomFichier, vbNull) <> True Then Exit Sub
 
    Set AcroPDDoc = AcroAVDoc.GetPDDoc
    iNumPages = AcroPDDoc.GetNumPages
    k = 2
    For i = 0 To iNumPages - 1
        Set PageNum = AcroPDDoc.AcquirePage(i)
        Set PageContent = CreateObject("AcroExch.HiliteList")
        If PageContent.Add(0, 8000) <> True Then Exit Sub
        Tst
        Set AcroTextSelect = PageNum.CreatePageHilite(PageContent)
        For j = 0 To AcroTextSelect.GetNumText - 1
            sContent = AcroTextSelect.GetText(j)
 
MsgBox sContent
Select Case sContent
Case Is = Range("K2").Value
MsgBox sContent
End Select
        Next j
 
 
 
    Next i
 
    AcroAVDoc.Close False
    AcroApp.Exit
 
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
 
    RchMotAdobePdf = sResultat
 
 
    Range("D1").Value = RchMotAdobePdf
 
End Sub

J'essaie de sélectionner mon texte avec

Code :

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

Test

, j'y parviens.

Mais si la MsgBox du code:

Code :

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

RechInPdf

me renvoie bien plusieurs valeurs dont celle dans

Code :

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

Range("K2").Value

, quand j'essaiede faire quelque chose avec:

Code :

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

sContent = Range("K2").Value

, rien en se passe et si je laisse filer:

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
 Next j
 
 
 
 
                Cells(ActiveCell.Row + 1, k) = sResultat 'i + 1
 
                k = k + 1
 
 
    Next i
 
    AcroAVDoc.Close False
    AcroApp.Exit
 
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
 
    RchMotAdobePdf = sResultat
 
 
    Range("D1").Value = RchMotAdobePdf
 
End Sub

Rien en se passe non plus.

Je sais bien que je partais d'une Function pour arriver à une Sub mais cela correspond mieux à mon cas, je cherche "simplement" à inscrire le résultat dans une céllule (pour l'instant) et non pas à l'intégrer dans toute la mise en page du Code que vous me suggérer.

Suis-je dans la bonne direction ou fais-je complètement fausse route???

MERCI

**kiki29** · 26/09/2018, 12h18

Salut, voir ici une utilisation qui fonctionne des 2 derniers fichiers proposés.

**Kestion100** · 26/09/2018, 16h02

Le code qui m'a permis d'arriver à mes fins:

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
Sub RechInPdf()
 
 
 
Dim AcroApp As Object, AcroAVDoc As Object, AcroPDDoc As Object, AcroTextSelect As Object
Dim PageNum As Object, PageContent As Object, sContent As String, i As Long, j As Long, k As Long, iNumPages As Long
Dim sResultat As String, sNomFichier As String, RchMotAdobePdf As String, Src As String
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
 
sNomFichier = Range("C" & ActiveCell.Row).Value
 
    If AcroAVDoc.Open(sNomFichier, vbNull) <> True Then Exit Sub
 
    Set AcroPDDoc = AcroAVDoc.GetPDDoc
    iNumPages = AcroPDDoc.GetNumPages
 
 
 
    For i = 0 To iNumPages - 1
        Set PageNum = AcroPDDoc.AcquirePage(i)
        Set PageContent = CreateObject("AcroExch.HiliteList")
        If PageContent.Add(0, 8000) <> True Then Exit Sub
 
        Set AcroTextSelect = PageNum.CreatePageHilite(PageContent)
        For j = 0 To AcroTextSelect.GetNumText - 1
            sContent = AcroTextSelect.GetText(j)
            Range("K1").Value = Replace(sContent, " ", "")
 
            Select Case Range("K3").Value
Case Is = "="
Range("E" & ActiveCell.Row).Value = Range("E" & ActiveCell.Row).Value & Range("C" & ActiveCell.Row).Value & Chr(10)
 
Case Is = "<>"
 
 
 
End Select
 
 
 
        Next j
 
 
    Next i
 
 
 
    AcroAVDoc.Close False
    AcroApp.Exit
 
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
 
Call Fermer_Un_Programme("Acrobat.exe")
 
 
 
   Range("C" & ActiveCell.Row + 1).Select
 
 
 
End Sub

**Kestion100** · 26/09/2018, 16h03

MERCI POUR LE COUP DE MAIN!!!!!!!!!!!!!!

**Kestion100** · 26/09/2018, 16h31

En effet, je ne suis pas programmeur mais j'ai trouvé ma solution à force de triturer ce code et grâce à ton aide.
Si c'est un jugement de valeur alors je suis très heureux de ne pas être un programmeur....

**kiki29** · 26/09/2018, 17h55

Salut, surtout que le tout 1er lien t'apportait une réponse à ton niveau.

Tester présence d'une chaine de caractères dans un pdf

Macros et VBA Excel

Discussions similaires

Partager

Partager