Sub ListAllHeadings()
' Paul Beverley - Version 04.11.22
' Creates a list of all headings by style name

myStyles = "Heading 1,Heading 2,Heading 3"
Set myFile = ActiveDocument
Documents.Add
Set rng = ActiveDocument.Content
For Each pa In myFile.Paragraphs
  myStart = pa.Range.Start
  myEnd = pa.Range.End
  myLen = Len(pa.Range.Text)
  If myLen = myEnd - myStart Then
    sty = pa.Range.Style
  Else
    sty = ""
  End If
  DoEvents
  If Len(sty) > 5 Then
    If InStr(myStyles, sty) > 0 Then
    Debug.Print sty, pa.Range.Text
      rng.FormattedText = pa.Range.FormattedText
      rng.Collapse wdCollapseEnd
    End If
  End If
  DoEvents
Next pa
End Sub