Attribute VB_Name = "PHRD_Num"
Option Explicit
Sub SimpleOutlineList()
    On Error Resume Next
    Dim aLstTmplt As ListTemplate
    For Each aLstTmplt In ActiveDocument.ListTemplates
        If InStr(aLstTmplt.Name, "<Simple Outline>") > 0 Then
            If Selection.Range.ListFormat.ListType > 1 Then
                Application.Run MacroName:="WordTricks.WTX.FormatNumberDefault"
                Exit Sub
            Else
                Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=aLstTmplt, ContinuePreviousList:=True, _
                    ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
                    wdWord10ListBehavior
                Exit Sub
            End If
        End If
    Next
    Set aLstTmplt = ActiveDocument.ListTemplates.Add(True, "<Simple Outline>")  '& Right(CDbl(Now), 5))
    For i = 1 To 9
        With aLstTmplt.ListLevels(i)
            Select Case i
            Case 1
                .NumberFormat = "%1."
                .NumberStyle = wdListNumberStyleArabic
                .NumberPosition = InchesToPoints(0)
                .TextPosition = InchesToPoints(0.5)
                .TabPosition = InchesToPoints(0.5)
                .ResetOnHigher = 0
            Case 2
                .NumberFormat = "%2."
                .NumberStyle = wdListNumberStyleLowercaseLetter
                .NumberPosition = InchesToPoints(0.5)
                .TextPosition = InchesToPoints(1)
                .TabPosition = InchesToPoints(1)
                .ResetOnHigher = 1
            Case 3
                .NumberFormat = "%3."
                .NumberStyle = wdListNumberStyleLowercaseRoman
                .NumberPosition = InchesToPoints(1)
                .TextPosition = InchesToPoints(1.5)
                .TabPosition = InchesToPoints(1.5)
                .ResetOnHigher = 2
            Case 4
                .NumberFormat = "(%4)"
                .NumberStyle = wdListNumberStyleArabic
                .NumberPosition = InchesToPoints(1.5)
                .TextPosition = InchesToPoints(2)
                .TabPosition = InchesToPoints(2)
                .ResetOnHigher = 3
            Case 5
                .NumberFormat = "(%5)"
                .NumberStyle = wdListNumberStyleLowercaseLetter
                .Alignment = wdListLevelAlignLeft
                .TextPosition = InchesToPoints(2.25)
                .TabPosition = InchesToPoints(2.25)
                .ResetOnHigher = 4
            Case 6
                .NumberFormat = "(%6)"
                .NumberStyle = wdListNumberStyleLowercaseRoman
                .NumberPosition = InchesToPoints(2)
                .TextPosition = InchesToPoints(2.5)
                .TabPosition = InchesToPoints(2.5)
                .ResetOnHigher = 5
            Case 7
                .NumberFormat = "%7)"
                .NumberStyle = wdListNumberStyleArabic
                .NumberPosition = InchesToPoints(2.25)
                .TextPosition = InchesToPoints(2.75)
                .TabPosition = InchesToPoints(2.75)
                .ResetOnHigher = 6
            Case 8
                .NumberFormat = "%8)"
                .NumberStyle = wdListNumberStyleLowercaseLetter
                .NumberPosition = InchesToPoints(2.5)
                .TextPosition = InchesToPoints(3)
                .TabPosition = InchesToPoints(3)
                .ResetOnHigher = 7
            Case 9
                .NumberFormat = "%9)"
                .NumberStyle = wdListNumberStyleLowercaseRoman
                .NumberPosition = InchesToPoints(2.75)
                .TextPosition = InchesToPoints(3.25)
                .TabPosition = InchesToPoints(3.25)
                .ResetOnHigher = 8
            End Select
            .TrailingCharacter = wdTrailingTab
            .Alignment = wdListLevelAlignLeft
            .StartAt = 1
            With .Font
                .Bold = wdUndefined
                .Italic = wdUndefined
                .StrikeThrough = wdUndefined
                .Subscript = wdUndefined
                .Superscript = wdUndefined
                .Shadow = wdUndefined
                .Outline = wdUndefined
                .Emboss = wdUndefined
                .Engrave = wdUndefined
                .AllCaps = wdUndefined
                .Hidden = wdUndefined
                .Underline = wdUndefined
                .Color = wdUndefined
                .Size = wdUndefined
                .Animation = wdUndefined
                .DoubleStrikeThrough = wdUndefined
                .Name = ""
            End With
            .LinkedStyle = ""
        End With
    Next
    Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=aLstTmplt, ContinuePreviousList:=False, _
        ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
        wdWord10ListBehavior
    Set aLstTmplt = Nothing
    CommandBars("ListTricks").Visible = True
End Sub