Applying New Multi-Level List to Existing Document with Manual Numbering and Existing Styles

macropod · #2 12-11-2020, 01:51 PM

The following two macros should do the job for you.

The first applies multi-level list numbering to Word's Heading Styles:

Code:

Sub ApplyMultiLevelHeadingNumbers()
Dim LT As ListTemplate, i As Long
Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For i = 1 To 9
  With LT.ListLevels(i)
    .NumberFormat = Choose(i, "%1", "%1.%2", "%1.%2.%3", "%1.%2.%3.%4", "%1.%2.%3.%4.%5", "%1.%2.%3.%4.%5.%6", "%1.%2.%3.%4.%5.%6.%7", "%1.%2.%3.%4.%5.%6.%7.%8", "%1.%2.%3.%4.%5.%6.%7.%8.%9")
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = CentimetersToPoints(-0.5 + i * 0.5)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = CentimetersToPoints(1 + i * 0.5)
    .ResetOnHigher = True
    .StartAt = 1
    .LinkedStyle = "Heading " & i
  End With
Next
End Sub

Headings and their numbers are also indented (in 0.5cm increments) according to their level, though you can change that (e.g. InchesToPoints using instead of CentimetersToPoints would change the indents to 0.5in).

The second macro converts your existing manual numbering to the applicable auto-numbered Heading Styles.

Code:

Sub ApplyHeadingStyles()
Dim Para As Paragraph, Rng As Range, iLvl As Long
With ActiveDocument.Range
  For Each Para In .Paragraphs
    Set Rng = Para.Range.Words.First
    With Rng
      If IsNumeric(.Text) Then
        While .Characters.Last.Next.Text Like "[0-9. " & vbTab & "]"
          .End = .End + 1
        Wend
        iLvl = UBound(Split(.Text, "."))
        If IsNumeric(Split(.Text, ".")(UBound(Split(.Text, ".")))) Then iLvl = iLvl + 1
        If iLvl < 10 Then
          .Text = ""
          Para.Style = "Heading " & iLvl
        End If
      End If
    End With
  Next
End With
End Sub

You may want to change other aspects of the Heading Style formatting to better suit your layout requirements.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Does a new set of styles in a template overwrite or remove the existing set of styles in a document?	dianahbr	Word	6	03-27-2018 11:12 PM
Multi-level numbering / styles	Andy Pilkington	Word	4	09-11-2014 05:29 AM
How 2: Different Styles in Multi-Level List	BrianWren	Word	1	10-21-2013 08:50 AM
Multi Level List Numbering	ShelleyHoward	Word	2	01-05-2012 01:37 PM
Multi-level list styles	qochi	Word	1	05-31-2011 01:16 AM