Слово VBA: найти красный шрифт и дать название главы

Question

Мне нравится искать часть моего документа и указывать последний заголовок.Мой документ имеет следующую структуру:

1. Глава 1

2. Глава 2

   2.1 Подглава 1

     Table with data
   

   2.2 подраздел 2

     Table with data
   

   2.n подраздел N

     Table with data
   

3. Глава 3

Что мне нравится делать, так это найти весь красный текст в одной из таблиц и выяснить, в какой главе (второй уровень) это указано.

Я попытался определить диапазон для каждой главы второго уровня и выполнить поиск в этом диапазоне.По какой-то причине мой поиск не ограничен диапазоном, а расширяется до конца документа.Поэтому любое нахождение красного текста в более поздней главе будет ошибочно отнесено к первой подглаве.

Я также читал, что ограничение поиска диапазоном является своего рода ошибкой (не возможно?) Из-за динамического диапазона (честно говоря, я все еще не до конца понимаю).Поэтому другой подход, который я мог бы себе представить, - это поиск по всему документу и просто выяснение последнего заголовка перед поиском.Я просто не знаю, как подойти к этому.

Мне бы очень хотелось указатель.Я продолжаю читать те же сообщения на форуме по этой теме, но не могу заставить его работать по мере необходимости.

Ниже того, что у меня есть.

Проблемы:

• первый поиск проходит во всех подглавах, но заголовок все еще находится в подглаве 1
• , если в подглаве нет красного текста, сценарий разрушается (пока не совсем уверен, чтона самом деле происходит)

мой код до сих пор:

Sub find_red_text()

Dim chapter As Range
Dim heading As Range
Dim session As String
Dim counter As Integer

Selection.HomeKey Unit:=wdStory ' go to the beginning of the document!
Set heading = ActiveDocument.Range(Start:=0, End:=0)
counter = 0 ' represent level1 headings
Do   ' Loop through headings
    Dim current As Long
    current = heading.Start
    Set heading = heading.GoTo(What:=wdGoToHeading, Which:=wdGoToNext)
    If heading.Start = current Then
        ' We haven't moved because there are no more headings
        Exit Do
    End If
    If heading.Paragraphs(1).OutlineLevel = wdOutlineLevel1 Then
        counter = counter + 1 ' count the level 1 headers
        heading.Expand Unit:=wdParagraph
    End If
    If (heading.Paragraphs(1).OutlineLevel = wdOutlineLevel2) And (counter = 2) Then ' special attention to the sub chapter in chapter 2
        heading.Expand Unit:=wdParagraph
        session = heading.Text
        Set chapter = heading.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
        With chapter.Find
            .Text = ""
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchKashida = False
            .MatchDiacritics = False
            .MatchAlefHamza = False
            .MatchControl = False
            .MatchByte = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Font.Color = wdColorRed
            Do While .Execute
                chapter.Select ' just for debug purpose
                MsgBox (chapter.Text & " in " & heading)
            Loop
        End With
    End If
Loop
End Sub

Кто-нибудь может помочь мне здесь?Я некоторое время смотрю на это, схожу с ума, читая одни и те же «решения», но он просто не делает то, что мне нужно ...

Answer 1

Как обычно: чем меньше, тем лучше.Мне удалось решить эту проблему, убрав немного беспорядка, и выполнив поиск по всему документу, и просто ограничил действие тем разделом, в котором я хочу, чтобы это произошло.

Ниже приведен мой пересмотренный код, который работает как шарм

Sub find_red_text()

Dim rng As Range
Dim endrange As Integer
Dim session As Range

endrange = 0 ' will be written with the end of the range (count of characters) to see if the range has changed or remain the same

Selection.HomeKey Unit:=wdStory ' go to the beginning of the document!
Set rng = ActiveDocument.Range(Start:=0, End:=0)

With rng.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop 'wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchByte = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Font.Color = wdColorRed '255
    Do While .Execute
        If rng.Information(wdEndOfRangeColumnNumber) = 2 Then 'only consider second column which is the findings!
            Set session = rng.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious)
            session.Expand Unit:=wdParagraph
            If (endrange = rng.End) Then 'no change in the end of the range, therefore we have finished the search!
                Exit Do
            Else ' keep going and push the endrange value out
                endrange = rng.End
            End If
            msgbox (rng.text & " in " & session.text)
        End If
    Loop
End With
End Sub

Основные необходимые изменения:

1) Я попробовал другой подход:выберите главу и выполните поиск в ней, чтобы: выполнить поиск по всему документу и отфильтровать результаты на основе главы

2) произошел хаос, потому что я достиг конца документа с поиском.Конечная позиция моего результата поиска больше никогда не менялась.Поэтому я отслеживаю конец диапазона и, если он больше не увеличивается, я прекращаю поиск / цикл.

Теперь работает как шарм :)