Rechercher des mots Excel dans Word

Bonjour,

J'ai deux fichiers : un Excel et un Word.

Dans le fichier Excel, j'ai une colonne qui contient une liste de mots sur plusieurs lignes.

Dans le fichier Word, j'ai un rapport.

--> Je souhaite à travers une macro Excel, parcourir toutes les lignes de ma colonne, chercher chaque mot dans mon rapport Word et renvoyer le numéro de page Word dans la cellule à côté. Si pas de correspondance, renvoyer "Non trouvé".

Merci d'avance pour votre aide.

Cordialement.

Bonjour,

Besoin classique. Voir démo jointe.

Pierre

Bonjour pierrep56,

ça correspond parfaitement à mon besoin.

Merci beaucoup .

Bonjour,

Dans la mesure où un mot peut apparaître plusieurs fois dans Word, serait-il possible de compter le nombre d'apparition du mot et récupérer les numéros des pages où le mot apparaît séparé par "/" ?

Merci par avance.

Bonjour,

Oui, bien sûr, il suffit de boucler comme ceci :

            While .Execute
                If .Found Then
                    .Parent.Select
                    T(i, 2) = IIf(T(i, 2) = "", "", T(i, 2) & " | ") & _
                              WordApp.Selection.Information(wdActiveEndAdjustedPageNumber)
                Else
                    T(i, 2) = "Non trouvé"
                End If
            Wend

(avec une barre verticale | comme séparateur pour que excel ne prenne pas la réponse pour une date)

Pierre

Avec nb d'occurences

C'est parfait

Merci beaucoup.

Bonjour,

Du coup comment faites vous pour que seul les mots entiers soient repérés svp?

Par exemple moi j'ai entre autre, le mot able à rechercher mais j'ai les mots table et anable qui sont recensés aussi...

Merci d'avance,

Nini

Bonjour Nini,

Pour repérer un "mot entier" genre 'able' et non 'table' ni 'cartable', il suffit d'ajouter l'option .MatchWholeWord = True

comme ceci :

With WordDoc.Content.Find
    .Text = T(i, 1)
    .Forward = True
    .MatchWholeWord = True
    While .Execute
    ...

Pierre

Bonjour Pierre,

Merci beaucoup, j'ai intégré ça et bien d'autres choses!! Je suis presque rendue au bout de ma macro .

J'ai quand même une question, dans la liste de mots à rechercher j'en ai 4 qui mepose problème :

  • true
  • false
  • zero
  • yourself

Lorsque je lance la macro, true et false sont traduits en français, puis les deux autres sont supprimés de la liste ... Savez vous par hasard, s'il existe des mots qu'on ne peut pas utiliser?

Merci d'avance,

Nini

je viens de m'apercevoir que les mots yourself et zero correspondent au deux dernières lignes de mon tableau, est ce qu'il y un nombre de ligne à ne pas dépasser pour la rechercher?

Je n'ai quasiment rien changé à la formule, voici ce que j'ai écrit :

Option Explicit

Public Const wdActiveEndAdjustedPageNumber = 1 'déclaration de la constante

Public T As Variant

Sub Import_Doc()

Dim Ndf As Variant, lg As Integer 'Ndf = fichier word et lg = nombre de mots interdits

Ndf = NDF_A_LIRE(ActiveWorkbook.Path & "\")

If Not Ndf = False Then

With Sheets("Feuil1")

lg = .Cells(Rows.Count, 1).End(xlUp).Row

T = Range("A2:D" & lg).Value

If Cherche_doc(Ndf) = "ok" Then .Range("A2").Resize(UBound(T, 1), UBound(T, 2)) = T

End With

End If

End Sub

Function Cherche_doc(Ndf As Variant) As String

Dim WordApp As Object, WordDoc As Object

Dim i As Integer

Cherche_doc = "Non trouvé"

On Error GoTo errhdlr

Set WordApp = CreateObject("Word.Application")

Set WordDoc = WordApp.Documents.Open(Ndf, ReadOnly:=True)

WordApp.Visible = False

For i = 1 To UBound(T, 1)

With WordDoc.Content.Find

.Text = T(i, 1)

.Forward = True

.MatchWholeWord = True

While .Execute 'compter le nombre de fois que le mot apparait et récuperer les numéros des pages ou le mot apparait (séparation avec |)

If .found Then

.Parent.Select

T(i, 3) = IIf(T(i, 3) = "", "", T(i, 3) & " | ") & _

WordApp.Selection.Information(wdActiveEndAdjustedPageNumber)

T(i, 4) = T(i, 4) + 1 'compteur

Else

T(i, 3) = "Non trouvé"

End If

Wend

End With

Next i

Cherche_doc = "ok"

WordDoc.Close

WordApp.Application.Quit

Set WordDoc = Nothing

Set WordApp = Nothing

Exit Function

errhdlr:

WordDoc.Close

WordApp.Application.Quit

Set WordDoc = Nothing

Set WordApp = Nothing

Cherche_doc = "Erreur"

End Function

Function NDF_A_LIRE(rep) As String

On Error Resume Next

ChDrive (Left(rep, 1))

ChDir rep

NDF_A_LIRE = Application.GetOpenFilename("Fichiers Word,*.doc;*.docx;*.docm") 'commande ouvrant le fichier word

End Function

Bonjour Nini,

Pour les mots 'true' et 'false' : ils font partie du vocabulaire du Vba, d'où leur traduction automatique.

Pour contourner cette traduction-à-la-con, il suffit d'ajouter un espace avant et après le mot dans la liste :

' true ' et non 'true' (sans les guillemets)

Pour les derniers mots de la liste => ??

Pour être bien sûr : les mots à chercher dont bien en colonne A ?? et qu'est-ce qu'il y a en colonne B ??

Pierre

edit : à la relecture, je ne suis plus très sûr du coup des espaces, ça exclut les 'true' en début de paragraphe ou en fin de phrase ... mais on peut faire autrement si besoin ...

Bonjour Nini,

Voici une démo avec true / false sans traduction-bête

Pierre

Bonjour Pierre,

milles mercis pour ton aide,

je te joint mes fichiers en mode simplifiés pour que tu vois ce qu'il y a en colonne 2, ce sont les utilisations interdites, je m'explique :

(c'est le module 3 ou j'ai intégré ta formule )

analyse (v) = le mot analyse ne peut pas être utilisé en tant que verbe

En ce qui concerne mon souci avec true et false.... j'ai essayé les deux solutions que tu m'as proposé, mais :

Pour la première, laisser un espace avant ou après me parait difficile car avec MatchWholeWord = true si j'ai un espace, la macro ne fonctionne pas

Pour la seconde, lorsque j'ajoute T(i, 1) = "" comme tu préconises, je n'ai plus aucun mots dans ma liste finale

Bon je débute alors je suppose que tout n'est pas jolie jolie dans le fichier (j'ai honte!) mais je vais améliorer ça car la macro est trop longue je reposterais à la fin le résultat final.

merci d'avance,

nini

avec la pj c'est mieux ....

16test.zip (92.86 Ko)

Bonjour Nini,

Pas très propre, en effet ...

Il n'en reste pas moins que ma dernière proposition fonctionne sur le doc test proposé dans le zip

Pierre

Je vais nettoyer déjà j'ai peu être quelque chose en amont qui empêche le bon fonctionnement,

En tout cas, merci beaucoup pour ton aide précieuse pour moi

Bonjour,

J'ai nettoyé pas mal mon fichier, je suis plutôt contente du résultat même si je n'ai pas de quoi me référé, je crois que l'on peut sans cesse améliorer finalement!

En revanche, je ne saisi pas le souci avec true et false, je vois bien que ca fonctionne dans le fichier de Pierre mais dans le miens, ca efface toutes les valeur de la colonne A... est ce que quelqu'un peut regarder mon fichier et m'expliquer svp?

merci beaucoup ...

J'ai une seconde question, est que qu'il est possible d'ajouter dans la même macro le fait de surligner avec Highlight = true le smots dans le word et d'enregistrer une copie ou dois je créer une seconde macro?

Je suis en train d'en créer une seconde en ce moment car je me suis dit qu'il vaut mieux faire une nouvelle recherche que sur les mots présents au document au lieu de rechercher tout les mots du dictionnaire (1362 pour le fichier réel), êtes vous d'accord avec cette logique? je doute ..

merci beaucoup,

8abandon.docx (15.12 Ko)
15test24.xlsm (33.47 Ko)
13ste-dictionary.xlsx (49.79 Ko)

bonne journée

Voici un code fonctionnel pour ton fichier mais soit attentif, pour éviter la traduction de "true", etc... :

* le tableau T reprend les colonnes A à C

T = Range("A2:C" & lg).Value

* dans le traitement au fur à mesure que l'on traite les mots de la colonne A, on "déplace" ce tableau vers la droite

* ainsi la colonne 1 devient le(s) page(s) et la 2 devient le nb d’occurrence(s). Mais pour que ça fonctionne, il est impératif d'effacer le mot et de mettre à zéro le nb

T(i, 1) = ""
T(i, 2) = 0   ' du fait de ta colonne B(adv)... 

* après le traitement le tableau T est collé à partir de la colonne C

.Range("C2").Resize(UBound(T, 1), UBound(T, 2)) = T

on ne touche donc pas aux colonnes A et B de la feuille

Enfin, précision : quand l'auteur indique son nom dans un code donné gratuitement, il est d'usage de ne pas l'effacer quand on l'utilise ... c'est plus correct.

Option Explicit

' ******************************************
' *****                                *****
' *****            pierrep56           *****
' *****  http://tatiak.canalblog.com/  *****
' *****                                *****
' ******************************************

Public Const wdActiveEndAdjustedPageNumber = 1

Public T As Variant

Sub Import_Doc()
Dim Ndf As Variant, lg As Integer

    Ndf = NDF_A_LIRE(ActiveWorkbook.Path & "\")
    If Not Ndf = False Then
        With Sheets("Feuil1")
            lg = .Cells(Rows.Count, 1).End(xlUp).Row
            T = Range("A2:C" & lg).Value
            If Cherche_doc(Ndf) = "ok" Then .Range("C2").Resize(UBound(T, 1), UBound(T, 2)) = T
        End With
    End If
End Sub

Function Cherche_doc(Ndf As Variant) As String
Dim WordApp As Object, WordDoc As Object
Dim i As Integer

    On Error GoTo errhdlr
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(Ndf, ReadOnly:=True)

    WordApp.Visible = False
    For i = 1 To UBound(T, 1)
        With WordDoc.Content.Find
            .Text = T(i, 1)
            T(i, 1) = ""
            T(i, 2) = 0
            .Forward = True
            .MatchWholeWord = True
            While .Execute
                If .Found Then
                    .Parent.Select
                    T(i, 1) = IIf(T(i, 1) = "", "", T(i, 1) & " | ") & _
                              WordApp.Selection.Information(wdActiveEndAdjustedPageNumber)
                    T(i, 2) = T(i, 2) + 1
                Else
                    T(i, 1) = "Non trouvé"
                End If
            Wend
        End With
    Next i
    Cherche_doc = "ok"

    WordDoc.Close
    WordApp.Application.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Exit Function

errhdlr:
    WordDoc.Close
    WordApp.Application.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Cherche_doc = "Erreur"
End Function

Bonjour Pierre,

merci encore,

désolée pour la signature, effectivement c'est tout à fait censé je vais la remettre ...

Rechercher des sujets similaires à "rechercher mots word"