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

Question

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)

Answer 1

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

Answer 2

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