Word: Extracting headings and heading bookmarks
In the unlikely event that you may need to extract all heading references and numbered headings, here are two macros to do this:
Sub PrintBookmarksAndText()
Dim doc As Document
Set doc = ActiveDocument
Set doctarget = Documents.Add
Dim tbl As Table
Dim newrow As Row
Dim bm As Bookmark
With doctarget
Set tbl = .Tables.Add(Selection.Range, 1, 3)
With tbl
.Cell(1, 1).Range.Text = "Bookmark"
.Cell(1, 2).Range.Text = "Heading Number"
.Cell(1, 3).Range.Text = "Heading"
End With
End With
For Each bm In doc.Bookmarks
If bm.Range.Paragraphs(1).Style Like "Heading*" Then
If Left(bm.Name, 4) = "_Ref" Then
Debug.Print bm.Name & vbTab & bm.Range.Paragraphs(1).Range.ListFormat.ListString & vbTab & Left(bm.Range.Paragraphs(1).Range.Text, Len(bm.Range.Paragraphs(1).Range.Text) - 1)
Set newrow = tbl.Rows.Add
newrow.Cells(1).Range.Text = bm.Name
newrow.Cells(2).Range.Text = bm.Range.Paragraphs(1).Range.ListFormat.ListString
newrow.Cells(3).Range.Text = Left(bm.Range.Paragraphs(1).Range.Text, Len(bm.Range.Paragraphs(1).Range.Text) - 1)
End If
End If
Next bm
End Sub
Sub PrintNumberedHeadings()
Dim doc As Document
Set doc = ActiveDocument
Set doctarget = Documents.Add
Dim tbl As Table
Dim newrow As Row
Dim bm As Bookmark
Dim para As Paragraph
With doctarget
Set tbl = .Tables.Add(Selection.Range, 1, 2)
With tbl
.Cell(1, 1).Range.Text = "Heading Number"
.Cell(1, 2).Range.Text = "Heading"
End With
End With
For Each para In doc.Paragraphs
If para.Style Like "Heading*" Then
Debug.Print para.Range.ListFormat.ListString & vbTab & Left(para.Range.Text, Len(para.Range.Text) - 1)
Set newrow = tbl.Rows.Add
newrow.Cells(1).Range.Text = para.Range.ListFormat.ListString
newrow.Cells(2).Range.Text = Left(para.Range.Text, Len(para.Range.Text) - 1)
End If
Next para
End Sub