Добавьте новую страницу после всех страниц, которые содержат определенный текст в документе Word - PullRequest
0 голосов
/ 18 июня 2019

Мне нужно добавить пустую страницу после всех страниц, содержащих определенное слово типа "S U M M A R Y".

Sub SelFind()
    Dim oRng As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Text = "S U M M A R Y             "
        Selection.GoTo What:=wdGoToBookmark, Name:="\Page"
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.InsertBreak Type:=wdPageBreak
    End With
lbl_Exit:
    Exit Sub
End Sub

Это делается для одной страницы. Как я могу перебрать все страницы.

Ответы [ 2 ]

2 голосов
/ 18 июня 2019

Simple Do Loop будет работать для вас:

Sub SelFind()


   ActiveDocument.Range.Select

    Do

    With Selection.Find
            .Text = "S U M M A R Y             "
            .Execute
    End With

        If Selection.Find.Found Then

            Selection.GoTo What:=wdGoToBookmark, Name:="\Page"
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.MoveLeft Unit:=wdCharacter, Count:=1
            Selection.InsertBreak Type:=wdPageBreak

        Else: GoTo nxt

        End If
    Loop

nxt:

ActiveDocument.Range.Select

    Do

    With Selection.Find
            .Text = "R O Y A L T Y             "
            .Execute
    End With

        If Selection.Find.Found Then
        Dim Rnddg As Integer
            Rnddg = Selection.Information(wdActiveEndPageNumber)

            If Rnddg Mod 2 > 0 Then
                Selection.GoTo What:=wdGoToBookmark, Name:="\Section"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Selection.InsertBreak Type:=wdPageBreak
            End If

        Else: Exit Sub

        End If
    Loop



End Sub
0 голосов
/ 18 июня 2019

Вы можете попробовать что-то на основе:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "S U M M A R Y             "
    .Replacement.Text = ""
    .Forward = True
    .Format = False
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found
    Set Rng = .Duplicate
    Set Rng = Rng.GoTo(What:=wdGoToPage, Name:=.Information(wdActiveEndPageNumber))
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\Page")
    Rng.Paragraphs.Last.Range.InsertAfter Chr(12) & Chr(12)
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
...