Цикл Word 2016 VBA до конца документа - PullRequest
Новая
       46

Цикл Word 2016 VBA до конца документа

0 голосов
/ 01 октября 2018

Я просмотрел много разных ответов в Интернете, но не смог найти решение, подходящее для моего кода.Я впервые пишу на VBA в Word (немного опытен в Excel).

Я думал этот пост может быть тем, что мне нужно, но он не останавливает цикл в концедокумента для меня.

Я пытаюсь вставить непрерывный разрыв раздела перед началом нового раздела, который я обозначаю как текст, отформатированный со стилем Заголовок 1. Я полностью готов сделать это по-другому и будублагодарен за ваши идеи! 

Sub InsertSectionBreak()
    ' Go to start of document
    Selection.HomeKey Unit:=wdStory

    ' Find next section based on header formatting, insert continuous section break just before
    '
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    Do While Selection.Find.Execute = True
        Selection.Find.Execute
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.InsertBreak Type:=wdSectionBreakContinuous
    Loop
End Sub

Ответы [ 2 ]

0 голосов
/ 02 октября 2018

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

Sub GetHeadingSpanText()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the text to find?")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  If .Find.Found = True Then
    Set Rng = .Paragraphs(1).Range
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    MsgBox Rng.Text
  End If
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

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

0 голосов
/ 01 октября 2018

Код в вопросе не плохой, но имеет серьезную проблему: Selection перемещается по направлению к передней части документа, чтобы вставить разрыв раздела.Это означает, что в следующий раз, когда Find запускается, он снова находит тот же заголовок 1 и, таким образом, многократно вставляет разрывы разделов в том же месте.

Другая проблема заключается в том, что код выполняет Find как часть Do While критерий (именно поэтому он не находит первый экземпляр заголовка 1 в документе).

Следующий пример кода работает с Range объектами вместо Selection.Вы можете думать о диапазоне как о невидимом выделении с очень важным отличием: может быть несколько диапазонов;выбор может быть только один.

В предлагаемом коде используются два диапазона: один для поиска, а другой для вставки разрыва раздела.Диапазон поиска устанавливается для всего документа.Успешность поиска сохраняется в логической переменной (bFound).

Если поиск успешен, найденный диапазон дублируется до диапазона для разрыва раздела.Duplicate делает независимую «копию» исходного диапазона, чтобы им можно было управлять независимо друг от друга.Затем диапазон разрыва раздела сворачивается до его начальной точки (воспринимается как нажатие стрелки влево), затем вставляется разрыв раздела.

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

Sub InsertSectionBreak()
    Dim rngFind As Word.Range, rngSection As Word.Range
    Dim bFound As Boolean

    Set rngFind = ActiveDocument.content

    ' Find next section based on header formatting, insert continuous section break just before
    '
    rngFind.Find.ClearFormatting
    rngFind.Find.style = ActiveDocument.styles("Heading 1")
    With rngFind.Find
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        bFound = .Execute
    End With

    Do While bFound
        Set rngSection = rngFind.Duplicate
        rngSection.Collapse wdCollapseStart
        rngSection.InsertBreak Type:=wdSectionBreakContinuous
        rngFind.Collapse wdCollapseEnd
        bFound = rngFind.Find.Execute
    Loop
End Sub
...