VBA converting manual numbering to auto numbering

macropod · #1 05-27-2021, 03:16 PM

In order for the numbering to re-start, you need to have a Style that's part of the numbering sequence. So, starting at first principles, you'd run something like:

Code:

Sub ApplyMultiLevelDefinitionLevelNumbers()
Dim LT As ListTemplate, i As Long
Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For i = 1 To 5
  With LT.ListLevels(i)
    .NumberFormat = Choose(i, "%1", "(%2)", "(%3)", "(%4)", "(%5)")
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = Choose(i, wdListNumberStyleNone, wdListNumberStyleLowercaseLetter, _
      wdListNumberStyleLowercaseRoman, wdListNumberStyleUppercaseLetter, _
      wdListNumberStyleArabic)
    .NumberPosition = 0
    .Alignment = wdListLevelAlignLeft
    .TextPosition = InchesToPoints(i * 0.25)
    .ResetOnHigher = True
    .StartAt = 1
    .LinkedStyle = "Definition Level " & i
  End With
  With ActiveDocument.Styles("Definition Level " & i)
    .ParagraphFormat.LeftIndent = InchesToPoints(i * 0.25 - 0.25)
    .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
End Sub

for which you need to have five Definition Level paragraph Styles.

You could then run:

Code:

Sub ApplyDefinitionLevelStyles()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 2).Range
      If .Characters.First <> "(" Then
        .Style = "Definition Level 1"
      Else
        i = Asc(Split(Split(.Text, "(")(1), ")")(0))
        Select Case i
          Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Definition Level 2" 'LowercaseLetter
          Case 65 To 90: .Style = "Definition Level 4" 'UppercaseLetter
          Case 48 To 57: .Style = "Definition Level 5" 'Arabic
          Case 105, 118, 120: .Style = "Definition Level 3" 'LowercaseRoman
        End Select
        .Collapse wdCollapseStart
        .MoveEndUntil " "
        .End = .End + 1
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

Shelley Lou · #2 05-28-2021, 01:08 AM

Just want to say a massive thank you to Paul, I now have a better understanding on the importance of styles in a document, why (a) was never restarting and I have now changed my template accordingly. I have run the second macro several times and everything appears to be working as it should, this has saved me a lot of amending time on large documents and I very much appreciate the help given on this forum.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Applying New Multi-Level List to Existing Document with Manual Numbering and Existing Styles	stanley	Word	4	12-15-2020 10:59 AM
page numbering for manual	Bursal	Word	1	07-29-2018 02:08 PM
List Numbering Set Numbering Value shows missing numbers as hidden text	lostenfeld	Word	9	01-03-2017 04:27 PM
Auto numbering macro	desireemm1	Word	1	12-10-2015 07:50 PM
auto page numbering	socomfort	Word	2	05-28-2012 04:19 PM