Word - Как выделить раздел многоуровневого списка с найденным словом

Sub Выделить_часть_списка()
    Dim i&, rStart&, rEnd&, LevelStart%, Li, Iskomoe$, Naydeno As Boolean
    Iskomoe = "ёёёё"
    For Each Li In ActiveDocument.Lists
        For i = 1 To Li.ListParagraphs.Count
            With Li.ListParagraphs(i).Range
                Select Case .ListFormat.ListType
                    Case wdListOutlineNumbering, wdListMixedNumbering
                        With ActiveDocument.Range(Start:=.Start, End:=.End).Find
                            .ClearFormatting
                            .Text = Iskomoe
                            .Forward = True
                            .Wrap = wdFindStop
                            .Format = False
                            .MatchWholeWord = False
                            .MatchCase = False
                            .MatchWildcards = False
                            .Execute
                            If .Found Then
                                Naydeno = True
                                Exit For
                            End If
                        End With
                End Select
            End With
        Next
        If Naydeno Then
            rStart = Li.ListParagraphs(i).Range.Start
            rEnd = Li.ListParagraphs(i).Range.End
            LevelStart = Li.ListParagraphs(i).Range.ListFormat.ListLevelNumber
            For i = i + 1 To Li.ListParagraphs.Count
                With Li.ListParagraphs(i).Range
                    If .ListFormat.ListLevelNumber > LevelStart Then
                        rEnd = .End
                    Else
                        Exit For
                    End If
                End With
            Next
            ActiveDocument.Range(rStart, rEnd).Select
            Exit For
        End If
    Next Li
End Sub

Sub Выделить_часть_списка()
    Dim i&, rStart&, rEnd&,  Li, Iskomoe$, Naydeno As Boolean
    Iskomoe = "ёёёё"
    For Each Li In ActiveDocument.Lists
        For i = 1 To Li.ListParagraphs.Count
            With Li.ListParagraphs(i).Range
                Select Case .ListFormat.ListType
                    Case wdListOutlineNumbering, wdListMixedNumbering
                        If .ListFormat.ListLevelNumber = 1 Then rStart = .Start
                        With ActiveDocument.Range(Start:=.Start, End:=.End).Find
                            .ClearFormatting
                            .Text = Iskomoe
                            .Forward = True
                            .Wrap = wdFindStop
                            .Format = False
                            .MatchWholeWord = False
                            .MatchCase = False
                            .MatchWildcards = False
                            .Execute
                            If .Found Then
                                Naydeno = True
                                Exit For
                            End If
                        End With
                End Select
            End With
        Next
        If Naydeno Then
            rEnd = Li.ListParagraphs(i).Range.End
            For i = i + 1 To Li.ListParagraphs.Count
                With Li.ListParagraphs(i).Range
                    If .ListFormat.ListLevelNumber > 1 Then
                        rEnd = .End
                    Else
                        Exit For
                    End If
                End With
            Next
            ActiveDocument.Range(rStart, rEnd).Select
            Exit For
        End If
    Next Li
End Sub