After invoking delete page macro, the custom footer page number format is incorrect.

[PBREP]

Hello VBA developers,

The code you see below performs customized formatting layouts (code not shown). The main problem is that blank pages are shown (Print preview and save to PDF).

[ul]
[li]The “Sub headerFooter()” had some edits to complement the new “Sub DeleteBlankParagraphs()” section in the macro.[/li]
[li]The “Sub DeleteBlankParagraphs(): is new code that deletes blank pages.[/li]
[/ul]

However, throughout the Word document, all of the page numbers (footer section) are incorrect (In Word and PDF).

What is happening is when the macro invoke the “DeleteBlankParagraphs”; the custom footer page number format is incorrect, beginning at chapter 2 and on (2-13, 3-14). In other words, after the blank paragraphs are deleted, all of the chapters essentially become one section. Therefore, the page number (after the dash) doesn’t restart at 1. Please see attached example.
In addition, when the Word doc is save to a PDF is when the TOC page is updated with the incorrect footer page numbers (from chapter 2 and so forth)

Would creating a macro that would change the type of section break so that it does not create a blank page be the solution and if so, what can be added to this macro?

Thank you all in advanced.
~PM

Code Excerpt below

 My macro ()
headerFooter
DeleteBlankParagraphs
End Sub
Sub headerFooter()
    Dim s As Section
    For Each s In ActiveDocument.Sections
        ' Configure header on all but first section
        If s.Index > 1 Then
            DoHeader s.Headers(wdHeaderFooterFirstPage)
            DoHeader s.Headers(wdHeaderFooterPrimary)
            DoHeader s.Headers(wdHeaderFooterEvenPages)
        End If
        
        ' Configure footer on all but first [three sections] 'two sections
        If s.Index > 2 Then 'Changed from a '2' to a "3" 03-15-2018
            DoFirstFooter s.Footers(wdHeaderFooterFirstPage)
            DoOddFooter s.Footers(wdHeaderFooterPrimary)
            DoEvenFooter s.Footers(wdHeaderFooterEvenPages)
        End If
    Next
End Sub

Sub DeleteBlankParagraphs()
    Dim s As Section
    Dim p As Paragraph
    
    ' Loop through all sections
    For i = ActiveDocument.Sections.Count To 1 Step -1
        If i = 2 Or i = 3 Then GoTo NextSection ' skip toc
        Set s = ActiveDocument.Sections(i)
        ' Loop through all paragraphs in the section
        For Each p In s.Range.Paragraphs
            ' Delete paragraph if it does not contain multiple characters
            If Len(p.Range.Text) <= 1 Then
                p.Range.Select
                ActiveDocument.Application.Selection.Delete
            End If
        Next
NextSection:
    Next
End Sub

 

[TonyJollans]

Your problem is that the Section Break is considered an empty paragraph by your code. It's not the most straightforward thing to catch but one way would be to add an extra condition before deleting ...

[blue]If Len(p.Range.Text) <= 1 _
p.Range.End <> p.Range.Sections(1).Range.End Then
[/blue]

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[PBREP]

Hi Tony,

Thank you for responding; I'll give it a whirl.

~PM