Microsoft Office Forums - View Single Post - [Solved] VBA Change to correct Heading style

Shelley Lou · 07-11-2022, 04:53 AM

Hi Macropod - So I've been working on the code you have previous supplied and have adapted this to be 1., 1.1, (a), (i), (A), (1) - I can't seem to figure out how to remove the bold from the actual number and also how to move Heading 2 back to the margin in alignment with Heading 1.

TEST.docx

Code:

Sub ApplyMultiLevelHeadingNumbers_B()
Application.ScreenUpdating = False
Dim LT As ListTemplate, i As Long
Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For i = 1 To 6
  With LT.ListLevels(i)
    .NumberFormat = Choose(i, "%1.", "%1.%2", "(%3)", "(%4)", "(%5)", "(%6)")
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = Choose(i, wdListNumberStyleArabic, wdListNumberStyleArabic, _
      wdListNumberStyleLowercaseLetter, wdListNumberStyleLowercaseRoman, wdListNumberStyleUppercaseLetter, _
      wdListNumberStyleArabic)
    .NumberPosition = 0
    .Alignment = wdListLevelAlignLeft
    .TextPosition = InchesToPoints(i * 0.5)
    .ResetOnHigher = True
    .StartAt = 1
    .LinkedStyle = "Heading " & i
  End With
  With ActiveDocument.Styles("Heading " & i)
    .ParagraphFormat.LeftIndent = InchesToPoints(i * 0.5 - 0.5)
    .ParagraphFormat.FirstLineIndent = 0 'InchesToPoints(-0.5)
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Font.Name = "Arial"
    .Font.Italic = False
    '.Font.Bold = False
    .Font.ColorIndex = wdAuto
    .Font.Size = 10
  End With
Next
Application.ScreenUpdating = True
End Sub

Numbering.PNG

When I run the other macro to update the manual numbering to auto it debugs at If bLvl = False Then Undo and the error Sub or Function not defined. I've googled this and changed the sub name but it still debugs and not sure what to do.

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
    StrTxt = Trim(.Range.Words.First.text): bLvl = False
    objUndo.StartCustomRecord ("Fmt")
      For i = 1 To 6
        .Style = "Heading " & i
        If .Range.ListFormat.ListString = StrTxt Then
          .Range.Words.First.text = vbNullString
          bLvl = True: Exit For
        End If
      Next
      objUndo.EndCustomRecord
      If bLvl = False Then Undo
    End With
  Next
End With
End Sub