Sub ApplyMultiLevelHeadingNumbers()
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)", "(%6)")
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = Choose(i, wdListNumberStyleNone, wdListNumberStyleLowercaseLetter, _
      wdListNumberStyleLowercaseRoman, wdListNumberStyleUppercaseLetter, _
      wdListNumberStyleArabic, wdListNumberStyleUppercaseRoman)
    .NumberPosition = 0
    .Alignment = wdListLevelAlignLeft
    .TextPosition = InchesToPoints(i * 0.25)
    .ResetOnHigher = True
    .StartAt = 1
    .LinkedStyle = "Heading " & i
  End With
  With ActiveDocument.Styles("Heading " & 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

Sub ApplyHeadingStyles()
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 = "Heading 1"
      Else
        i = Asc(Split(Split(.Text, "(")(1), ")")(0))
        Select Case i
          Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Heading 2" 'LowercaseLetter
          Case 65 To 90: .Style = "Heading 4" 'UppercaseLetter
          Case 48 To 57: .Style = "Heading 5" 'Arabic
          Case 105, 118, 120: .Style = "Heading 3" 'LowercaseRoman
        End Select
        .Collapse wdCollapseStart
        .MoveEndUntil " "
        .End = .End + 1
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub