Rechercher un mot en boucle et inserer un signet indexé

[ouskel'n'or]

L'exemple suivant implique les éléments suivants :
- Le texte cherché est toujours identique
- Le signet est appliqué au paragraphe entier à partir du mot cherché
- Le nom de l'index sera "Signet" & index

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub InsérerSignetEnBoucle()
Dim i as integer
Dim LeMot
LeMot = "Début" 'mot cherché
    Selection.HomeKey Unit:=wdStory 'On se place en début de document
    With Selection.Find
        .ClearFormatting
        'Début la boucle de recherche : Tant que la donnée est trouvée, on continue
        Do While .Execute(FindText:=LeMot, Forward:=True, _
                  Wrap:=wdFindStop) = True
 
            'Sélection jusqu'en fin de ligne
            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
 
            'Insertion d'un signet indexé
            i = i + 1
            ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
                  Name:="Signet" & i
        Loop
    End with
End Sub