Option Explicit 
 
Private Sub Document_Open() 
    Dim oButton As Office.CommandBarControl 
     
    CustomizationContext = NormalTemplate 'Make changes to Normal.dot
     
     'Add button to right-click menu
    Set oButton = Application.CommandBars("Text").Controls.Add 
     
     'Set properties of button
    With oButton 
        .Caption = "Show Bookmarks" 
        .FaceId = 351 
        .Style = msoButtonIconAndCaption 
        .OnAction = "ThisDocument.ShowBookmarksInSelection" 
        .BeginGroup = True 
    End With 
     
     'Clean up
    Set oButton = Nothing 
End Sub 
 
Private Sub Document_Close() 
    On Error Resume Next 
    CustomizationContext = NormalTemplate 'Make changes to Normal.dot
     
     'Delete button on right-click menu
    Application.CommandBars("Text").Controls("Show Bookmarks").Delete 
End Sub 
 
Sub ShowBookmarksInSelection() 
    Dim oRange  As Word.Range 
    Dim oBm     As Word.Bookmark 
    Dim sMsg    As String 
     
    Set oRange = Selection.Range 
     
    For Each oBm In oRange.Bookmarks 'loop trough bookmarks in range
        sMsg = sMsg & oBm.Name & vbCrLf 'build string off bookmark names
    Next 
     
     'If any
    If sMsg <> "" Then 
        MsgBox sMsg 'show bookmark names
    End If 
     
     'Clean up
    Set oRange = Nothing 
End Sub