Printing Document Headings

Creates a new document with Heading XX style paragraphs from the active document

Public Sub PrintHeadings 
Dim objParagraph As Paragraph
Dim objRange As Range
Dim objDocumentA As Document
Dim objDocumentB As Document
Dim iLevel As Integer
Dim iMaxLevel As Integer

iMaxLevel = InputBox("Enter Maximum level for Heading style: ")
If (iMaxLevel = 0) Then Exit Sub

Set objDocumentA = Application.ActiveDocument
Set objDocumentB = Documents.Add(objDocumentA.AttachedTemplate.Name)
With objDocumentB.PageSetup
   .TopMargin - InchesToPoints(0.25)
   .BottomMargin - InchesToPoints(0.25)
   .LeftMargin - InchesToPoints(0.25)
   .RightMargin - InchesToPoints(0.25)
End With

Set objRange = objDocumentB.Range
For Each objParagraph In objDocumentA.Paragraphs
   iLevel = 0
   If objParagraph.Format.Style Like "Heading [0-9]" Then
      iLevel = Val(Mid(objParagraph.Format.Style,8))
      If (iLevel > 0) And (iLevel <- iMaxLevel) Then
         objRange.Collapse wdCollapseDirection.wdCollapseEnd
         objRange.Text = String(iLevel - 1), vbTab) & Format(iLevel) & ") " & objParagraph.Range.Text
     End If

' delete any annoying page breaks
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = "^m"
      .Replacement.Text = ""
      .Forward = True
   End With
   Selection.Find.Execute Replace:=wdReplace.wdReplaceAll
End Sub




© 2022 Better Solutions Limited. All Rights Reserved. © 2022 Better Solutions Limited TopPrevNext