Выделение заголовка с определенным уровнем нумерации

Sub Header_1()
    Dim Li, Par, k%
    For Each Par In ActiveDocument.Content.Paragraphs
        With Par.Range
            If .Style.NameLocal Like "Заголовок*" Then
                k = Val(Mid(.Style.NameLocal, 11, 1)) ' Определяем номер уровня заголовка 1, 2 б 3 и т.д.
                With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(k).Font
                    .Name = "Times New Roman"
                    .Size = 14
                    .Bold = True
                    .Italic = False
                    .Underline = wdUnderlineNone
                    .Color = wdColorAutomatic
                End With
                .ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
                ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _
                ContinuePreviousList:=True, ApplyTo:=wdListApplyToWholeList, _
                DefaultListBehavior:=wdWord10ListBehavior
                .ListFormat.ListLevelNumber = k ' 
                With .Font
                    .Name = "Times New Roman"
                    .Size = 14
                    .Bold = True
                    .Italic = False
                    .Underline = wdUnderlineNone
                    .Color = wdColorAutomatic
                End With
            End If
        End With
    Next Par
End Sub