Microsoft Office Forums - View Single Post - [Solved] Is there a way to summarise all bookmarks and cross references used in a Word document?

macropod · 11-09-2017, 12:06 AM

While it is possible to generate a list of bookmarks and all the cross-references to them, there is no way for Word to tell you whether they point to the 'correct' place.

The following macro generates a table of all bookmarks at the end of either the active document or a new document, plus another table of all references to those bookmarks, each table including details of the story range names, page & line numbers and contents:

Code:

Sub ListBkMrksAndRefs()
Application.ScreenUpdating = False
Dim oBkMrk As Bookmark, StrBkMk As String, StrXREf As String, StrStory As String
Dim wdDocIn As Document, wdDocOut As Document, Rng As Range, Fld As Field, bHid As Boolean, Dest, r As Long
Dest = MsgBox(Prompt:="Output to New Document? (Y/N)", Buttons:=vbYesNoCancel, Title:="Destination Selection")
If Dest = vbCancel Then Exit Sub
Set wdDocIn = ActiveDocument
If Dest = vbYes Then Set wdDocOut = Documents.Add
If Dest = vbNo Then Set wdDocOut = wdDocIn
With wdDocIn
  bHid = .Bookmarks.ShowHidden
  .Bookmarks.ShowHidden = True
  If .Bookmarks.Count > 0 Then
    StrBkMk = vbCr & "Bookmark" & vbTab & "Page" & vbTab & "Line" & vbTab & "Story" & Chr(160) & "Range" & vbTab & "Contents"
    StrXREf = vbCr & "Bookmark Ref" & vbTab & "Page" & vbTab & "Line" & vbTab & "Story" & Chr(160) & "Range" & vbTab & "Type" & vbTab & "Text"
    For Each oBkMrk In .Bookmarks
      Select Case oBkMrk.StoryType
        Case 1: StrStory = "Main text"
        Case 2: StrStory = "Footnotes"
        Case 3: StrStory = "Endnotes"
        Case 4: StrStory = "Comments"
        Case 5: StrStory = "Text frame"
        Case 6: StrStory = "Even pages header"
        Case 7: StrStory = "Primary header"
        Case 8: StrStory = "Even pages footer"
        Case 9: StrStory = "Primary footer"
        Case 10: StrStory = "First page header"
        Case 11: StrStory = "First page footer"
        Case 12: StrStory = "Footnote separator"
        Case 13: StrStory = "Footnote continuation separator"
        Case 14: StrStory = "Footnote continuation notice"
        Case 15: StrStory = "Endnote separator"
        Case 16: StrStory = "Endnote continuation separator"
        Case 17: StrStory = "Endnote continuation notice"
        Case Else: StrStory = "Unknown"
      End Select
      StrBkMk = StrBkMk & vbCr & oBkMrk.Name & vbTab & _
        oBkMrk.Range.Characters.First.Information(wdActiveEndAdjustedPageNumber) & vbTab & _
        oBkMrk.Range.Information(wdFirstCharacterLineNumber) & vbTab & StrStory & vbTab & oBkMrk.Range.Text
    Next oBkMrk
    For Each Rng In .StoryRanges
      Select Case Rng.StoryType
        Case 1: StrStory = "Main text"
        Case 2: StrStory = "Footnotes"
        Case 3: StrStory = "Endnotes"
        Case 4: StrStory = "Comments"
        Case 5: StrStory = "Text frame"
        Case 6: StrStory = "Even pages header"
        Case 7: StrStory = "Primary header"
        Case 8: StrStory = "Even pages footer"
        Case 9: StrStory = "Primary footer"
        Case 10: StrStory = "First page header"
        Case 11: StrStory = "First page footer"
        Case 12: StrStory = "Footnote separator"
        Case 13: StrStory = "Footnote continuation separator"
        Case 14: StrStory = "Footnote continuation notice"
        Case 15: StrStory = "Endnote separator"
        Case 16: StrStory = "Endnote continuation separator"
        Case 17: StrStory = "Endnote continuation notice"
        Case Else: StrStory = "Unknown"
      End Select
      For Each Fld In Rng.Fields
        With Fld
          Select Case .Type
            Case wdFieldRef, wdFieldPageRef
            StrXREf = StrXREf & vbCr & Split(Trim(.Code.Text), " ")(1) & vbTab & _
              .Result.Characters.First.Information(wdActiveEndAdjustedPageNumber) & vbTab & _
              .Result.Information(wdFirstCharacterLineNumber) & vbTab & _
              StrStory & vbTab & Split(Trim(.Code.Text), " ")(0) & vbTab & .Result
          End Select
        End With
      Next
    Next
  Else
    MsgBox "There are no bookmarks in this document", vbExclamation
    GoTo Done
  End If
End With
With wdDocOut
  Set Rng = .Range.Characters.Last
  With Rng
    .Text = StrBkMk
    .Start = .Start + 1
    .ConvertToTable Separator:=vbTab
    With .Tables(1)
      .AutoFitBehavior wdAutoFitContent
      .Columns.Borders.Enable = True
      .Rows.Borders.Enable = True
      .Rows.First.Range.Font.Bold = True
      If Dest = vbNo Then
        For r = 2 To .Rows.Count 
          Set Rng = .Cell(r, 1).Range: StrBkMk = Split(Rng.Text, vbCr)(0) 
          ActiveDocument.Hyperlinks.Add Rng, , ActiveDocument.Bookmarks(StrBkMk).Range.Characters.First, StrBkMk, StrBkMk 
        Next
      End if 
    End With
  End With
  Set Rng = .Range.Characters.Last
  With Rng
    .Text = StrXREf
    .Start = .Start + 1
    .ConvertToTable Separator:=vbTab
    With .Tables(1)
      .AutoFitBehavior wdAutoFitContent
      .Columns.Borders.Enable = True
      .Rows.Borders.Enable = True
      .Rows.First.Range.Font.Bold = True
    End With
  End With
  .Bookmarks.ShowHidden = bHid
End With
Done:
Set Rng = Nothing: Set wdDocIn = Nothing: Set wdDocOut = Nothing
Application.ScreenUpdating = True
End Sub

Note that line numbers only apply to the main story. Other stories will return -1.

If the output is to the parent document, the first table will include hyperlinks to the bookmarks.

For PC macro installation & usage instructions, see: Installing Macros
For Mac macro installation & usage instructions, see: https://wordmvp.com/Mac/InstallMacro.html