Recherche mot dans .PDF avec macro VBA

Version imprimable

16/06/2011, 10h10
klemsy20

Recherche mot dans .PDF avec macro VBA

Bonjour,

Je souhaite savoir s'il est possible de lancer une recherche dans un document .pdf depuis une macro excel.
Dans mon cas, je veux cliquer sur une case de mon tableau excel contenant un mot.
ce mot est alors recherché dans le document pdf.

Faute d'avoir trouvé comment parcourir un pdf, j'ai essayé de le lire en page web (internet explorer) puis d'y rechercher le mot, cela marche assez bien mais c'est assez laborieux et pas optimisé à mon avis.
Je voudrais donc savoir s'il est possible de rechercher directement un mot sur un pdf par une macro VBA. Si oui, merci de partager un exemple si vous en avez.

Merci d'avance.

Salut,à tenter , je précise que j'ai Acrobat Reader et Distiller, donc dans ton cas je ne sais pas si cela fonctionnera
A priori l'installation d'Acrobat Reader 9.0 devrait suffire ,avec la version 10 ?

Code:

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
Option Explicit
 
Sub Tst()
Dim Fichier As Variant
Dim sMot As String
 
    sMot = "Mot recherché"
    ChDir ThisWorkbook.Path
 
    Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    If Fichier <> False Then AcrobatFindTexte Fichier, sMot
End Sub
 
Private Sub AcrobatFindTexte(ByVal sFichier As String, ByVal sRch As String)
Dim oApp As Object
Dim oAvDoc As Object
Dim TextTrouvé As Integer
 
    Set oApp = CreateObject("AcroExch.App")
    oApp.Hide
 
    Set oAvDoc = CreateObject("AcroExch.AVDoc")
 
    If oAvDoc.Open(sFichier, "") Then
            '  Parametres FindText
            '                StringToSearchFor ,
            '                caseSensitive (1 Or 0),
            '                WholeWords(1 Or 0),
            '                ResetSearchToBeginOfDocument (1 Or 0)
 
            ' Renvoie -1 si trouvé, 0 autrement
        TextTrouvé = oAvDoc.FindText(sRch, True, False, True)
    End If
 
    oApp.Show
    oAvDoc.BringToFront
 
    Set oAvDoc = Nothing
    Set oApp = Nothing
End Sub

Salut kiki29,

Merci pour ta réponse, j'ai bien compris ton code et comment ça devrait marcher mais malheureusement je n'ai pas Acrobat reader... donc ça ne marche pas.

Ce que j'ai fais finalement, c'est que j'ouvre mon PDF en page web et j'utilise des Sendkeys, mais ça ne marche toujours pas :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub Recherche() Dim ie As Object, strFile As String, iPageNum As Long Dim i As Long strFile = "C:\Documents and Settings\p061104\Desktop\Dossier technique.pdf" i = 1 Set ie = CreateObject("InternetExplorer.Application") ie.navigate strFile ie.Visible = True SendKeys "^f" Do While ie.busy Loop SendKeys "Mot recherché" SendKeys "{ENTER}" End Sub
Si tu vois où est le problème... Merci d'avance pour ton aide.

17/06/2011, 12h53
kiki29

Salut,le Reader est gratuit donc cela ne mange pas de pain de l'installer
voir pour la version 9.0 sur http://get.adobe.com/fr/reader/otherversions/ la 10 semble pour le moment problématique
17/06/2011, 13h32
klemsy20

Salut et merci pour ton temps,

Le problème c'est qu'en fait je suis en stage dans un boîte et que je ne peux pratiquement rien télécharger parce que j'ai pas les droits utilisateur dans le pc, c'est un peu dommage parce que ta solution était exactement ce que je cherchais. Merci quand même.

Là j'essaie d'arranger mon autre code (ci dessus), si tu y vois quelque chose qui ne va pas, merci de me le dire.

Bonne journée.

Re,ton code modifié

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
Sub Recherche()
Dim ie As Object, strFile As String
 
    strFile = "C:\Faq\Faq VBA\Exemples\PDF\Page main PDF.pdf"
 
    Set ie = CreateObject("InternetExplorer.Application")
 
    ie.navigate strFile
    ie.Visible = True
 
    Do Until ie.ReadyState = 4
        DoEvents
    Loop
 
    SendKeys "^f", True
    SendKeys "Investments", True
    SendKeys "{ENTER}"
 
    Set ie = Nothing
End Sub

17/06/2011, 14h08
klemsy20

Mercii ça marche !

Une dernière question : voilà ma feuille contient un tableau avec un mot par cellule, j'ai posé une condition sur le doubleClick pour qu'à chaque fois que l'utilisateur doubleclik sur une cellule, ça le renvoit directement vers le fichier pdf à l'emplacement du mot.

Le seul problème c'est comme maintenant le mot est une variable je ne connais pas la synthaxe exacte à mettre entre les guillemets du Sendkeys.

J'ai mis Sendkeys "ActiveCell" mais ça ne marche pas comme je m'y attendais parce qu'il al considère comme une chaine de caractèrse. Donc je me demandais si on pouvait utiliser les Sendkeys avec des variables ?

Merci. (Tu es entrain de me sauver la vie tu peux pas imaginer...:ccool: )

Salut,le code qui sera à adapter

Code:

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
Option Explicit
 
Sub SelectionFichier2()
Dim FD As FileDialog, sStr As String
 
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "PDF", "*.pdf", 1
        .ButtonName = "Ouvrir fichier"
        .Title = "Sélectionner un fichier PDF"
    End With
 
    If FD.Show = True Then
        DoEvents
        sStr = "Investments"
        RchMot_PDF_IExplorer FD.SelectedItems(1), sStr
    End If
 
    Set FD = Nothing
End Sub
 
Sub RchMot_PDF_IExplorer(sFichier As String, sMot As String)
Dim IE As Object
 
    Set IE = CreateObject("InternetExplorer.Application")
 
    IE.Navigate sFichier
    IE.Visible = True
 
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
 
    SendKeys "^f", True
    SendKeys sMot, True
    SendKeys "{ENTER}"
 
    Set IE = Nothing
End Sub

17/06/2011, 15h41
amnorian

pour info

http://jacxl.free.fr/cours_xl/cours_...cherche_ds_pdf

Salut, j'ai adapté ton code à mon cas mais voilà ça ne marche tjs pas.
J'ai mis un "Sheets("Feuil1").Cells(1, 1).Value = sMot" à la fin pour vérifier à chaque fois que je clique sur une cellu qu'il execute bien le code jusqu'a la fin et qu'il prend bien le bon mot. Mais il m'ouvre juste le fichier pdf sans effectuer le ctrl+f et l'écriture du mot dans la recherche. Voilà mon code :
Code:

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 Option Explicit Sub SelectionFichier2() Dim strFile As String, sStr As String strFile = "C:\Documents and Settings\p061104\Desktop\Dossier technique.pdf" sStr = ActiveCell.Value RchMot_PDF_IExplorer strFile, sStr End Sub Sub RchMot_PDF_IExplorer(sFichier As String, sMot As String) Dim IE As Object Set IE = CreateObject("InternetExplorer.Application") IE.Navigate sFichier IE.Visible = True Do Until IE.ReadyState = 4 DoEvents Loop SendKeys "^f", 250 SendKeys sMot, 250 SendKeys "{ENTER}" Sheets("Feuil1").Cells(1, 1).Value = sMot Set IE = Nothing End Sub

17/06/2011, 16h49
kiki29
Salut, tu es confronté aux joies des SendKeys .... ton code fonctionne sur mon PC
Remplace les "250" par True , chose que j'ai fait plus haut car en fait Wait est une variable booléenne :oops:
Place des temporisations

Code:

Application.Wait (Now + TimeValue("00:00:02"))

entre les SendKeys , les valeurs seront sans doute à ajuster

Une autre possibilité en millisecondes via
Code:

1 2 3 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ..... Sleep 250
Et balise ton code stp

Salut,
Merci pour ta proposition ça marche! :ccool:

Voilà mon code avec les tempos

Code:

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
 
Sub SelectionFichier2()
Dim strFile As String, sStr As String
 
    strFile = "C:\Documents and Settings\p061066\Desktop\Capitalisations\" & _
    Sheets("Feuil1").Cells(2, 2).Value & _
    "\" & _
    Sheets("Feuil1").Cells(3, 2).Value & "\Dossier technique.pdf"
 
    sStr = ActiveCell.Value 'Valeur de la cellule double cliquée par l'utilisateur
    RchMot_PDF_IExplorer strFile, sStr 'Appel de la fonction de recherche
 
 
End Sub
 
Sub RchMot_PDF_IExplorer(sFichier As String, sMot As String)
 
Dim IE As Object
 
    Set IE = CreateObject("InternetExplorer.Application")
 
    IE.Navigate sFichier
 
 
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
 
    IE.Visible = True
 
    SendKeys "^f", True
    Application.Wait (Now + TimeValue("00:00:01"))
    SendKeys sMot, True
    Application.Wait (Now + TimeValue("00:00:01"))
    SendKeys "{ENTER}"
 
    Set IE = Nothing
 
End Sub

Merci encore pour ton aide

22/06/2011, 11h37
klemsy20
Salut,
J'avais une question sur comment parcourir une ligne qui contient des cellules fusionnées. En fait j'utilise une boucle comme ceci qui parcourt les cellules de la première ligne de la feuille jusqu'à trouver une cellule vide puis s'arrête. Et là avec la valeur du i je sélectionne les cellules jusqu'à la cellule non vide et copie la selection pour la coller sur une autre feuille plustard
Code:

1 2 3 4 5 6 7 8 Sheets("Feuil1").Select i = 0 Do i = i + 1 Loop Until IsEmpty(Cells(1, i)) = True Range(Cells(1, 3), Cells(1, i)).Select Selection.Copy
Mais voilà le problème c'est que plusieurs de mes cellules sont des cellules fusionnées et je me suis dis que c'est peut être pour ça que ça ne marche pas.

As tu une idée de comment parcourir des cellules fusionnées avec une condition sur la vacuité ?

Merci d'avance.
22/06/2011, 11h45
kiki29
Salut,j'ai ajouté les 2 solutions de parcours de fichiers PDF dans mon pense bête http://www.developpez.net/forums/d43...bat-distiller/

Les cellules fusionnées n'apportent que des problemes dés que l'on doit utiliser du VBA,mis à part supprimer la fusion puis la rétablir après traitement.
Code:

1 2 3 Dim LastRow As Long '..... LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
Extrait de l'aide en ligne sur Copy , cela evite les Select

Code:

Worksheets("Sheet1").Range("A1:D4").Copy destination:=Worksheets("Sheet2").Range("E5")
22/06/2011, 13h37
klemsy20
Salut et merci

En fait ton code parcours plutot les lignes et les compte, je l'ai adapté pour parcourir et compter des colonnes de cette façon mais je ne suis pas sur que la synthaxe sois exacte :
Code:

1 2 3 4 Dim LastCol As Long '..... LastCol = Feuil1.Range(Columns.Count & "1").End(xlToLeft).Column
Peux tu me dire où est ce que j'aurais pu me tromper ? Merci pour ton temps.

C'est bon ça marche en fait j'ai remplacé par :

Code:

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

par contre le problème c'est qu'il compte bien jusqu'à la dernière colonne mais pas jusqu'à la dernière cellule. Le problème c'est que si ma dernière colonne est composée de 3 cellules fusionnées par exemple il les prend pas en compte et ne parcours pas véritablement jusqu'à la fin. Une idée pour palier à ce problème ?
22/06/2011, 14h27
kiki29

Re, se débarrasser des cellules fusionnées ,sinon concernant les dernieres lignes ou colonnes voir le tuto de Joel sur http://www.developpez.net/forums/d45...gnees-feuille/
25/09/2019, 14h15
marie764

Rechercher mots sur PDF depuis Excel

Bonjour,
Je m'y connais pas trop en language VBA

Je cherche à ouvrir un PDF depuis Excel et faire une recherche sur un mot précis dans le PDF.
Cette macro me serait bien utile mais je ne sais pas par quoi remplacer les éléments mis en rouge ?
Est-il possible de m'aider si je donne des informations supplémentaires ?
Je recherche le mot "MEDHI" dans le lien qui est sur le lien D:\\Bulletin_clarifie\Bulletin.pdf

Merci par avance

Fuseau horaire GMT +2. Il est actuellement 10h58.