Insert Blank if Section ends on ODD page Word Macro

Question

What I have to achieve:

There are two types of data in my word document, "Summary" and "Royalty", can have multiple of these two section in one document. but always in same sequence "Summary -> Royalty -> Summary -> Royalty"

I have to add a blank page after Every Summary page. that will always be of one page max.
For Royalty, If the Royalty Section Starts page number 2 and ends on 4 means total count of the pages is 3, in this case i have to add a blank page after this.

Code Written till now is below:

Sub Add_Page_After_Summary()
'
' Add_Page_After_Summary Macro

' Add_Page_After_Summary
'
' Sample Code
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 startpage As Integer
        Dim endpage As Integer
        startpage = Selection.Information(wdActiveEndPageNumber)
        Selection.GoTo What:=wdGoToBookmark, Name:="\Section"
        endpage = Selection.Information(wdActiveEndPageNumber)

        Dim difference As Integer
        difference = endpage - startpage

        If difference 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

My current code is doing as below: it checks the starting of Royalty Section and it fetchs the ending of the royalty section that occurs in last of document, that is issue, i want to get the current Royalty Section. Please help.

i think so, if we find the just next Summary to it that will work i Guess.. — Ram Singh
we need to get the page number of up coming Summary Page, from which we can get the total number of pages of current Royalty Section and can do check ODD number check — Ram Singh

Timothy Rylatt Timothy Rylatt · Accepted Answer · 2019-06-18T15:33:56

If I have understood you correctly it sounds as though you want each section to begin on an odd page. If that is correct then adding an Odd Page Section Break before each Summary or Royalty heading should do the trick. This forces a blank page to be added as required when the document is printed or saved as a pdf.

Sub Test()
  InsertSectionBreaks "S U M M A R Y             "
  InsertSectionBreaks "R O Y A L T Y             "
End Sub

Sub InsertSectionBreaks(FindText As String)
  Dim FindRange As Word.Range, SectionRange As Word.Range
  Dim Found As Boolean

  Set FindRange = ActiveDocument.Content

  ' Find next section based on text, insert odd page section break just before
  FindRange.Find.ClearFormatting
  With FindRange.Find
    .Text = FindText
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    Found = .Execute
  End With

  Do While Found
    'avoid adding a section break at beginning of document
    If FindRange.Information(wdActiveEndAdjustedPageNumber) > 1 Then
      Set SectionRange = FindRange.Duplicate
      With SectionRange
        .Expand wdParagraph
        .Collapse wdCollapseStart
        .InsertBreak Type:=wdSectionBreakOddPage
      End With
    End If
    FindRange.Collapse wdCollapseEnd
    Found = FindRange.Find.Execute
  Loop
End Sub

Insert Blank if Section ends on ODD page Word Macro

1 Answers