Is there a way to summarise all bookmarks and cross references used in a Word document?

Training · #1 11-08-2017, 08:41 PM

A client is using Word 2010. They have a 300 page document with track changes turned on. The document contains numerous bookmarks and cross references throughout the 300 pages. There has been a lot of copy/paste happening within the document and from external documents.
Is there a way to summarise all the bookmarks and cross references used, rather than having to test each one individually to see if its referring to the correct place?

Thanks for any ideas everyone.

macropod · #2 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
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
          If (.Type = wdFieldRef) Then
            StrXREf = StrXREf & vbCr & Split(Trim(.Code.Text), " ")(1) & vbTab & _
            .Result.Characters.First.Information(wdActiveEndAdjustedPageNumber) & vbTab & _
            .Result.Information(wdFirstCharacterLineNumber) & vbTab & StrStory & vbTab & "Ref"
          ElseIf (.Type = wdFieldPageRef) Then
            StrXREf = StrXREf & vbCr & Split(Trim(.Code.Text), " ")(1) & vbTab & _
            .Result.Characters.First.Information(wdActiveEndAdjustedPageNumber) & vbTab & _
            .Result.Information(wdFirstCharacterLineNumber) & vbTab & StrStory & vbTab & "PageRef"
          End If
          StrXREf = StrXREf & vbTab & .Result
        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
    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.

For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm
For Mac macro installation & usage instructions, see: https://wordmvp.com/Mac/InstallMacro.html

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Where to put Subroutine to make sure bookmarks aren't deleted so cross-references work	mrsjetset	Word VBA	5	06-29-2016 05:06 PM
cross references and dynamic numbering in a document	JJ_Writing	Word	4	11-05-2015 02:19 AM
Updating document causes change lines on all cross references. :(	garybeck	Word	2	05-08-2015 09:15 PM
Convert manual cross references in footnotes to other footnotes to automatic cross references	ghumdinger	Word VBA	7	11-20-2014 11:47 PM
Bookmarks & cross-references	Suchoklates	Word	1	09-19-2013 02:32 AM