Deprecated: RegularLabs\Library\ArrayHelper::implode(): Implicitly marking parameter $last_glue as nullable is deprecated, the explicit nullable type must be used instead in /homepages/10/d550841420/htdocs/libraries/regularlabs/src/ArrayHelper.php on line 225
Je cherche à faire une macro qui détecte un mot particulier et surligne en jaune le paragraphe concerné.

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,3% France
Canada 5,3% Canada
Chine 3,7% Chine

Total:

154

Pays
018458002
Aujourd'hui: 187
Hier: 236
Cette semaine: 187
Semaine dernière: 2.729
Ce mois: 5.930