Compter le ou les mots d'une liste ds un document et donner leurs N° de pages

[ouskel'n'or]

Objet : Comptabiliser les mots d'une liste dans un texte et connaître les N° de pages dans lesquelles ils se trouvent

Sub ChercherTrouver()
Dim Recherche As Boolean
Dim TabloMots As Variant, TabloPages(), TabloQu(), i As Integer
Dim DerLigne As Byte
    TabloMots = Array("", "tata", "papa", "maman", "pépé", "mémé", "tonton", "michel")
    ReDim TabloPages(UBound(TabloMots))
    ReDim TabloQu(UBound(TabloMots))
    For i = 1 To UBound(TabloMots)
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .Text = TabloMots(i)
            .MatchWholeWord = True 'recherche sur le mot entier (True par défaut)
            .Execute
            Recherche = .Found
        Do While Recherche
            TabloQu(i) = TabloQu(i) + 1
            TabloPages(i) = TabloPages(i) & "," & Selection.Information(wdActiveEndPageNumber)
            .Execute
            Recherche = .Found
        Loop
        End With
    Next
 
    'Affichage
    For i = 1 To UBound(TabloMots)
        If Not TabloQu(i) = Empty Then _
            MsgBox TabloMots(i) & " a été trouvé " & TabloQu(i) & " fois " & _
                       " pages " & Right(TabloPages(i), Len(TabloPages(i)) - 1)
    Next
End Sub

Pour faire une recherche sur toutes les occurences (mots cherchés contenus dans d'autres mots) mettre la propriété

      .MatchWholeWord = False

[ouskel'n'or]

But : Permettre la saisie du mot ou de la liste des mots à chercher

Sub ChercherTrouver()
Dim Recherche As Boolean, UnMot as string
Dim TabloMots(), TabloPages(), TabloQu(), i As Integer
    Do
          UnMot = inputbox("Saisir un nouveau mot", "SAISIE de la LISTE","")
          if Trim(UnMot) <> "" then
                i = i + 1
                Redim Preserve TabloMots(i)
                TabloMots(i) = UnMot
          endif
    Loop while trim(UnMot) <> ""
    if i = 0 then exit sub
    ReDim TabloPages(UBound(TabloMots))
    ReDim TabloQu(UBound(TabloMots))
    For i = 1 To UBound(TabloMots)
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .Text = TabloMots(i)
            .MatchWholeWord = True 'recherche sur le mot entier (True par défaut)
            .Execute
            Recherche = .Found
        Do While Recherche
            TabloQu(i) = TabloQu(i) + 1
            TabloPages(i) = TabloPages(i) & "," & Selection.Information(wdActiveEndPageNumber)
            .Execute
            Recherche = .Found
        Loop
        End With
    Next
 
    'Affichage
    For i = 1 To UBound(TabloMots)
        If Not TabloQu(i) = Empty Then _
            MsgBox TabloMots(i) & " a été trouvé " & TabloQu(i) & " fois " & _
                       " pages " & Right(TabloPages(i), Len(TabloPages(i)) - 1)
    Next
End Sub