View Single Post
 
Old 07-11-2022, 03:44 PM
macropod's Avatar
macropod macropod is offline Windows 10 Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,520
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

How is it that you have two Heading 2 formats?

To remove the bold attribute from all except the first two heading levels, all you need do is insert:
.Font.Bold = Choose(i, 1, 1, 0, 0, 0, 0)
after, say,:
.NumberPosition = 0

For the indents, replace:
.ParagraphFormat.LeftIndent = InchesToPoints(i * 0.5 - 0.5)
with:
Code:
    Select Case i
      Case 1, 2
         .ParagraphFormat.LeftIndent = 0
      Case Else
      .ParagraphFormat.LeftIndent = InchesToPoints((i - 2) * 0.5)
    End Select
To apply the Styles given that you have differing number levels and formats present, use:
Code:
Sub ApplyHeadingStyles_Auto()
Dim Para As Paragraph, Rng As Range, i As Long, StrTxt As String, bLvl As Boolean
Dim objUndo As UndoRecord: Set objUndo = Application.UndoRecord
With ActiveDocument.Range
  For Each Para In .Paragraphs
    With Para
      Set Rng = .Range
      With Rng
        .Collapse wdCollapseStart
        .MoveEndUntil vbTab, wdForward
         StrTxt = .Text: bLvl = False
         .End = .End + 1
      End With
      objUndo.StartCustomRecord ("Fmt")
      For i = 1 To 6
        .Style = "Heading " & i
        If .Range.ListFormat.ListString = StrTxt Then
         Rng.Text = vbNullString
          bLvl = True: Exit For
        End If
      Next
      objUndo.EndCustomRecord
      If bLvl = False Then ActiveDocument.Undo
    End With
  Next
End With
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote