Recherche

 

L’exemple suivant cherche dans la Sélection le mot ‘mot’ et surligne chaque paragraphe trouvé. Pour une recherche dans tout le document faire d’abord Ctrl+A.

 

 Public Sub toto()
'macro écrite par guy moncomble
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
     .MatchWildcards = True
     .Text = "[M,m]ot" 'le mot peut avoir une majuscule
          While .Execute
               Selection.Paragraphs(1).Range.Select
               Selection.Range.HighlightColorIndex = wdYellow
               Selection.Collapse wdCollapseEnd
          Wend
End With
End Sub

 

 

Voici une autre macro plus élaborée qui demande quel est le texte à rechercher, surligne les paragraphes et les insère dans un nouveau document :

End Sub
Sub recherche()
'macro écrite par m@rina
Dim mon_texte As String, Liste As String, ND As Document

mon_texte = InputBox("Quel mot voulez-vous trouver ?""Recherche")
If mon_texte = "" Then Exit Sub

Application.ScreenUpdating = False
ActiveDocument.Range.HighlightColorIndex = none
Selection.HomeKey Unit:=wdStory
'Recherche de tous les mots
    Do
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .ClearFormatting
            .Text = mon_texte
            .Forward = True
            .Wrap = wdFindStop
            .MatchCase = True
            .MatchWildcards = False
            .MatchAllWordForms = True
            .Execute
        End With

    If Selection.Find.Found Then
        texte_para = Selection.Paragraphs(1).Range
        Selection.Paragraphs(1).Range.HighlightColorIndex = wdYellow
            If InStr(Liste, texte_para) = 0 Then
                Liste = Liste & texte_para & vbCr
            End If
        End If
    Loop Until Not Selection.Find.Found

'On crée le nouveau doc et on y insère les textes trouvés
    If Liste <> "" Then
    Set ND = Documents.Add
    Selection.TypeText Text:=Liste
        Else: MsgBox "Le mot n'a pas été trouvé"
    End If
End Sub

Statistiques

France 72,1% France
Canada 7,7% Canada
Belgique 3,8% Belgique

Total:

117

Pays
018308631
Aujourd'hui: 32
Hier: 386
Cette semaine: 1.361
Semaine dernière: 2.467
Ce mois: 4.023