Private Const TitreTableauRecap As String = "TabRecapSignet"
Public Sub ListerSignets()
Dim tabRecap As Table, signet As Bookmark
'récupérer le tableau
For Each tabRecap In ThisDocument.Tables
If tabRecap.Title = TitreTableauRecap Then Exit For
Next tabRecap
If tabRecap Is Nothing Then
MsgBox "Le tableau """ & TitreTableauRecap & """ n'a pas été trouvé dans le document." & vbNewLine & "Fin de la macro...", vbCritical, "Erreur"
Exit Sub
End If
'nettoyer le tableau (spprimer toutes les lignes sauf les 2 premières)
While tabRecap.Rows.Count > 2
tabRecap.Rows(3).Delete
Wend
'boucler sur chaque signet, ajouter le lien hypertexte et le numéro de page
For Each signet In ThisDocument.Bookmarks
tabRecap.Rows.Add
ThisDocument.Hyperlinks.Add tabRecap.Rows(tabRecap.Rows.Count).Cells(1).Range, , signet.Name, , signet.Name
tabRecap.Rows(tabRecap.Rows.Count).Cells(2).Range.Text = signet.Range.Information(wdActiveEndPageNumber)
Next signet
'supprimer la 2ème ligne
tabRecap.Rows(2).Delete
End Sub