CODEWITHSUNDEEP
vbams-word
YFeizi
YFeizi

Reputation: 1528

add page break with macro (if there isnt any page break)

I want to add a page break before every heading 1 and evey \page bookmark. This is my code that work : 

Sub PageBreack(isok)
    If isok <> True Then
         Exit Sub
    End If
    Selection.GoTo What = wdGoToLine, Which = wdGoToFirst

    Application.Browser.Target = wdBrowsePage
    For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")
        If i > 1 Then
            ActiveDocument.Bookmarks("\page").Range.Select
            Selection.InsertBreak Type:=wdSectionBreakContinuous  'wdSectionBreakNextPage
        End If
        Application.Browser.Next
    Next i
    For Each p In ActiveDocument.Paragraphs
      If Left(p.Style, 9) = "Heading 1" Then
        p.Range.Select
        Selection.Previous.InsertBreak Type:=wdSectionBreakContinuous
      End If
    Next
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^12": .Replacement.Text = "^m": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

My problem is that this code doesnt check that exist any page break and add a new page break there.
how to change my code that macro check if there isnt any page break add a page break ?
(English is not my native language , i hope explain clearly)

Upvotes: 0

Views: 1328

Answers (2)

amini gazar
amini gazar

Reputation: 91

you have blank pages by use page break macro Here is a macro to delete all the blank pages in a Word Document 

Sub Demo()
With ActiveDocument.Content.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^12[^12^13 ]{1,}"
    .Replacement.Text = "^12"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With
End Sub

reference:Remove Blank Pages from Docx using word interop

Sub PageBreack(isok)
    If isok <> True Then
         Exit Sub
    End If
    Selection.GoTo What = wdGoToLine, Which = wdGoToFirst

    Application.Browser.Target = wdBrowsePage
    For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")
        If i > 1 Then
            ActiveDocument.Bookmarks("\page").Range.Select
            Selection.InsertBreak Type:=wdSectionBreakContinuous  'wdSectionBreakNextPage
        End If
        Application.Browser.Next
    Next i
    With ActiveDocument.Styles("Heading 1").ParagraphFormat
        .PageBreakBefore = True
    End With
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^12": .Replacement.Text = "^m": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^12[^12^13 ]{1,}"
        .Replacement.Text = "^12"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Upvotes: 1

Rahul
Rahul

Reputation: 11520

If no answers come, You can use your existing code and add one more step of checking for double page breaks.

Selection.Find.Replacement.ClearFormatting

With Selection.Find
    .Text = "^m^m": .Replacement.Text = "^m": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Upvotes: 1

Related Questions