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