Option Explicit

Sub modifierIndexParagTsStyles()
' Pour remplacer dans l'index le numéro de page par le numéro de paragraphe
' Traite les champs XE simples, donc de la forme : XE "mot"
' en ajoutant un champ STYLEREF vers le paragrphe numéroté ou prcédent.
' Voir http://www.faqword.com/index.php/word/references/90
'          Tout en bas de la page.
' La sélection du paragraphe numéroté est basée sur le fait que le nom du style du paragraphe
'  contient un mot déterminé, typiquement "Titre"
Dim doc As Document ' document ouvert
Dim champ As Field
Dim champRef As Field
Dim pos1 As Long
Dim contenuChamp As String
Dim texteRef As String
Dim TexteRenvoi As String
Dim texteStyle As String
Dim pointInsertion As Long
Dim r As Range
Dim par As Paragraph
Dim ignorer As Boolean

' ---------------- A définir :
TexteRenvoi = " \t ""§" & Chr(160)  ' espace insécable
texteStyle = "numéroté" '"Titre"

Set doc = ActiveDocument
ActiveWindow.ActivePane.View.ShowAll = True

For Each champ In doc.Fields
  If champ.Type = wdFieldIndexEntry Then ' entrées d'index wdFieldIndexEntry
    ignorer = False
    contenuChamp = champ.Code.Text
    'Debug.Print champ.Code.Sentences(1)
    ' Ignorer ceux qui sont déjà complets ainsi que les renvois du genre "Voir"
    pos1 = InStr(contenuChamp, TexteRenvoi)
    If pos1 > 0 Then ignorer = True
    pos1 = InStr(contenuChamp, "\t ")
    If pos1 > 0 Then ignorer = True
    pos1 = InStr(contenuChamp, "STYLEREF ")
    If pos1 > 0 Then ignorer = True
    If ignorer = False Then
        ' Se placer en fin du champ
        champ.Code.Text = contenuChamp & TexteRenvoi & " "" "
        champ.Select
        Set r = Selection.Range
        pointInsertion = r.End - 4
        ' recherche du style de titre qui précède
        Set par = r.Paragraphs(1)
        pos1 = InStr(par.Style.NameLocal, texteStyle)
        If pos1 > 0 Then ' c'est un style titre
          nomStyle = par.Style.NameLocal
        Else
        'remonter paragraphe par paragraphe
          Do
          Set par = par.Previous
          If par Is Nothing Then Exit Do
          pos1 = InStr(par.Style.NameLocal, texteStyle)
          If pos1 > 0 Then ' c'est un style titre
            nomStyle = par.Style.NameLocal
            Exit Do
          End If
          Loop
        End If
        doc.Range(Start:=pointInsertion, End:=pointInsertion).Select
        texteRef = "STYLEREF """ & nomStyle & """ \n"
        Set champRef = doc.Fields.Add(Range:=Selection.Range, Type:=wdFieldEmpty, Text:=texteRef)
      End If
    Else
     'pas un champ à traiter : ignoré
    End If

Next

End Sub

Sub remetIndexSurPage()
' Retraite les champs XE "mot" \t "§" ...
'  pour les remettre à leur état le plus simple : XE "mot"
Dim doc As Document ' document ouvert
Dim champ As Field
Dim pos1 As Long
Dim contenuChamp As String
Dim delimiteur As String
Dim mot As String
Set doc = ActiveDocument
' Indiquer ici le texte qui détermine le début du contenu du champ à éliminer
delimiteur = " \t ""§"
'Afficher les codes des champs
ActiveWindow.ActivePane.View.ShowAll = True
For Each champ In doc.Fields
    If champ.Type = wdFieldIndexEntry Then ' entrées d'index
      contenuChamp = champ.Code.Text
      pos1 = InStr(contenuChamp, delimiteur)
      If pos1 > 0 Then
        champ.Code.Text = Mid(contenuChamp, 1, pos1 - 1)
      End If
    End If
Next
End Sub

Sub supprimeEntreeDIndex()
' Efface tous les champs XE vers un mot qui est défini dans la macro
Dim doc As Document ' document ouvert
Dim champ As Field
Dim contenuChamp As String
Dim mot As String
Set doc = ActiveDocument
' Indiquer ici le texte qui détermine le début du contenu du champ à éliminer
mot = "Royaune"
'Afficher les codes des champs
ActiveWindow.ActivePane.View.ShowAll = True
For Each champ In doc.Fields
    If champ.Type = wdFieldIndexEntry Then ' entrées d'index
      If champ.Code.Words(4).Text = mot Then
        champ.Delete
      End If
    End If
Next
End Sub