Recherche d'un ou plusieurs mots d'une liste dans un Document - Trois options

[ouskel'n'or]

Trois options (les deux premières ne nécessitent aucune sélection)

*********************************************************
1 - Le tableau Word et le texte objet de la recherche sont situés dans le même document.
La liste des mots à rechercher est située dans la colonne 1 d'un tableau à deux colonnes placé dans la section 1.
Le texte objet de la recherche est placé dans la section 2

Sub ChercherTrouver()
'Désactiver la mise à jour de l'application pour éviter les mouvements de pages
Application.ScreenUpdating = False
Dim Doc1 As Document
Dim TableauDesMots(), i As Integer, NoLigne As Byte
Dim DerLigne As Byte
Set Doc1 = ActiveDocument
    DerLigne = Doc1.Tables(1).Rows.Count
    ReDim Preserve TableauDesMots(DerLigne)
    For NoLigne = 1 To DerLigne
        TableauDesMots(NoLigne) = Doc1.Tables(1).Cell(NoLigne, 1)
        'Suppression de vbcrlf en fin de cellule et ajout du No de ligne
        'formaté sur 4 caractères
        TableauDesMots(NoLigne) = Trim(Left(TableauDesMots(NoLigne), _
        Len(TableauDesMots(NoLigne)) - 2)) & Right("0000" & NoLigne, 4)
    Next
    
    For i = 1 To UBound(TableauDesMots)
        If recherche(Left(TableauDesMots(i), Len(TableauDesMots(i)) - 4), Doc1) Then
            'récup du No de ligne dans le tableau
            NoLigne = Val(Right(TableauDesMots(i), 4))
            'Insertion d'une croix dans la colonne 2 du tableau word
            ActiveDocument.Tables(1).Cell(NoLigne, 2).Range.Text = "X"
        End If
    Next
 
'Réactiver la mise à jour de l'application
Application.ScreenUpdating = True
End Sub
 
Function recherche(LeMot As String, Doc1 As Document) As Boolean
Dim Plage
    Set Plage = Doc1.Sections(2).Range
        With Plage.Find
            .Text = LeMot
            recherche = .Execute
        End With
End Function

**********************************************************
2 - La liste des mots et le texte sont placés dans deux documents différents.
Le document 1 contient la macro, et la liste des mots.
La liste des mots est un tableau Word à deux colonnes dans le premier document.
La colonne 1 contient les mots à rechercher, 1 mot par cellule
La colonne 2 est destinée à recevoir une croix si le mot est trouvé
Le texte à parcourir est dans le second document.

Les documents
"Tableau des mots.doc" contient la macro et le tableau des mots
"C:\Le Rep\Le Texte.doc" contient le texte

Sub ChercherTrouver()
Dim Doc1 As Document
Dim Doc2 As Document
Dim TableauDesMots(), ok As Boolean, i As Integer
Dim DerLigne As Byte
'Désactiver la mise à jour de l'application pour éviter les mouvements de pages
Application.ScreenUpdating = False
    Set Doc1 = Documents("Tableau des mots.doc") 'contient la macro
    Set Doc2 = Documents.Open("C:\Le Rep\Le Texte.doc") 'contient le texte
    DoEvents
    DerLigne = Doc1.Tables(1).Rows.Count
    ReDim Preserve TableauDesMots(DerLigne)
    For NoLigne = 1 To DerLigne
        TableauDesMots(NoLigne) = Doc1.Tables(1).Cell(NoLigne, 1)
        'Suppression de vbcrlf en fin de cellule
        'et ajout du No de ligne formaté sur 4 caractères
        TableauDesMots(NoLigne) = Trim(Left(TableauDesMots(NoLigne), _
        Len(TableauDesMots(NoLigne)) - 2)) & Right("0000" & NoLigne, 4)
    Next
    
    For i = 1 To UBound(TableauDesMots)
        ok = recherche(Left(TableauDesMots(i), Len(TableauDesMots(i)) - 4), Doc2)
        If ok Then
            'récup du No de ligne dans le tableau
            NoLigne = Val(Right(TableauDesMots(i), 4))
            'insertion d'une croix dans la colonne adjascente
            Doc1.Tables(1).Cell(NoLigne, 2).Range.Text = "X"
        End If
    Next
 
'Réactiver la mise à jour de l'application
Application.ScreenUpdating = True
End Sub
 
Function recherche(LeMot As String, Doc2 As Document) As Boolean
Dim Plage
    Set Plage = Doc2.Content
        With Plage.Find
            .Text = LeMot
            recherche = .Execute
        End With
End Function

**********************************************************
3 - Les mots cherchés sont situés dans un tableau() dans le code de la macro
Le texte objet de la recherche est situé dans le document contenant la macro

Sub ChercherTrouver()
Dim Doc1 As Document
Dim TableauDesMots As Variant, i As Integer
Dim DerLigne As Byte
    Set Doc1 = ActiveDocument
    TableauDesMots = Array("", "tata", "papa", "maman", "pépé", "mémé", "tonton", "michel")
    For i = 1 To UBound(TableauDesMots)
        If recherche(TableauDesMots(i)) Then
            MsgBox TableauDesMots(i) & " trouvé et sélectionné page " & Selection.Information(wdActiveEndPageNumber)
        End If
    Next
End Sub
 
Function recherche(LeMot As Variant) As Boolean
    Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .Text = LeMot
            recherche = .Execute
        End With
End Function

Un grand merci à 3dfroggy qui a été l'initiateur par sa question