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

Sub Макрос2()
 
    Dim myBookmark As Word.Range
    Dim myFind As Word.Find
    
    
    '1. Создаём виртуальную закладку (похожа по поведению
        'на обычную Word-закладку) и даём этой закладке VBA-имя "myBookmark".
        'С помощью этой закладки будем перемещаться по документу.
    Set myBookmark = ActiveDocument.Range(Start:=0, End:=0)
    
    '2. Создаём объект, который будет вести поиск.
    Set myFind = myBookmark.Find
    
    '3. Настраиваем объект поиска.
    '3.1. Поиск с учётом форматирования.
    'В нашем случае форматирование - это стиль,
        'который применёнт к тексту.
    myFind.Format = True
    '3.2. Указываем, текст, с каким стилем ищем.
    myFind.Style = ActiveDocument.Styles("Заголовок ур. 2")
    
    '4. Осуществляем поиск до тех пор, пока есть результат поиска.
    Do While myFind.Execute = True
    
        'Если найдено, то закладка окружит найденный текст.
        '5. Смотрим, есть ли вообще в найденном тексте многоуровневый список.
        If myBookmark.ListFormat.ListType = wdListOutlineNumbering Then
            
            '6. Узнаём уровень списка.
                'myBookmark.ListFormat.ListString -
                    'это текст (номер), который мы видим в Word-документе.
                'С помощью "Split" разбиваем номер на части на основе точки.
                'С помощью "UBound" узнаём, сколько частей у нас получилось.
            'Если в номере будет 2 точки, т.е. перед нами третий уровень,
                'то команда "Split" даст три элемента. Но порядковый номер
                'первого элемента ноль (так запрограммировано). Поэтому команда "Ubound" даст число 2.
            If UBound(Split(myBookmark.ListFormat.ListString, ".")) = 2 Then
            
                '7. Убираем у абзаца жирность.
                'ListParagraphs() - это абзац, который содержит нумерацию.
                'ListParagraphs(1) - это первый абзац в каком-то фрагменте документа.
                    'В нашем случае всегда будет один абзац, но порядковый номер всё-равно нужно указывать.
                myBookmark.ListParagraphs(1).Range.Font.Bold = False
                
            End If
 
        End If
        
        '8. Перемещаем закладку за найденный текст,
            'чтобы поиск продолжился в остальной части документа.
        myBookmark.Collapse Direction:=wdCollapseEnd
    
    Loop
 
End Sub

Sub Сделать_нежирным_3ий_уровень_заголовков()
    Dim Li, Par
    For Each Li In ActiveDocument.Lists
        For Each Par In Li.ListParagraphs
            With Par.Range
                If .ListFormat.ListType = wdListOutlineNumbering Then
                    If .ListFormat.ListLevelNumber = 3 Then
                        If .Style.NameLocal Like "Заголовок*" Then
                            .ListFormat.ListTemplate.ListLevels(3).Font.Bold = False
                            .Font.Bold = False
                        End If
                    End If
                End If
            End With
        Next Par
    Next Li
End Sub

Sub Header_1()
    Dim Li, Par, k%
    For Each Li In ActiveDocument.Lists
        For Each Par In Li.ListParagraphs
            With Par.Range
                If .Style.NameLocal Like "Заголовок*" Then
                    .ListFormat.ListType = wdListOutlineNumbering
                    k = Val(Mid(.Style.NameLocal, 10, 1))
                    .ListFormat.ListLevelNumber = k
                    .ListFormat.ListTemplate.ListLevels(k).Font.Bold = True
                    With .Font
                        .Name = "Times New Roman"
                        .Size = 14
                        .Bold = True
                        .Italic = False
                        .Underline = wdUnderlineNone
                    End With
                    With .Style.ParagraphFormat
                        .LeftIndent = CentimetersToPoints(0)
                        .RightIndent = CentimetersToPoints(0)
                        .SpaceBefore = 12
                        .SpaceBeforeAuto = False
                        .SpaceAfter = 6
                        .SpaceAfterAuto = False
                        .LineSpacingRule = wdLineSpaceSingle
                        .Alignment = wdAlignParagraphJustify
                        .WidowControl = True
                        .KeepWithNext = True
                        .KeepTogether = False
                        .PageBreakBefore = False
                        .NoLineNumber = False
                        .Hyphenation = True
                        .FirstLineIndent = CentimetersToPoints(0)
                        .OutlineLevel = wdOutlineLevel1
                        .CharacterUnitLeftIndent = 0
                        .CharacterUnitRightIndent = 0
                        .CharacterUnitFirstLineIndent = 0
                        .LineUnitBefore = 0
                        .LineUnitAfter = 0
                        .MirrorIndents = False
                        .TextboxTightWrap = wdTightNone
                    End With
                End If
            End With
        Next Par
    Next Li
End Sub