Help, my VBA code inserts blank pages!

[mangoagent]

I am trying to insert page breaks (next page type) for each Heading 1 section. This works fine, but inserts blank pages before each heading type. After this, I run another set of code that sends each section to a fax printer, but it also wants to individually send these blank pages separately. So, if someone can help me figure out how to avoid the blank page plague, I'd very much appreciate it! Here's the code:

Sub SecBreak()
Dim parLoop As Word.Paragraph
Dim sel As Word.Selection
For Each parLoop In ActiveDocument.Paragraphs
If parLoop.Format.Style = "Heading 1" Then
parLoop.Range.Select
Set sel = Application.Selection
sel.Collapse direction:=WdCollapseDirection.wdCollapseStart
sel.InsertBreak WdBreakType.wdSectionBreakNextPage

End If
Next
End Sub

[macropod]

Hi mangoagent,

Why are you inserting Section breaks, rather than formatting the Heading 1 Style with a 'page break before'? A whole lot less work IMHO. Indeed, if the Style is properly formatted before the document is created, you don't even need any code for that aspect.

[mangoagent]

Hi mangoagent,

Why are you inserting Section breaks, rather than formatting the Heading 1 Style with a 'page break before'? A whole lot less work IMHO. Indeed, if the Style is properly formatted before the document is created, you don't even need any code for that aspect.

Hi macropod, and thanks for the advice.

The code that sends these section by section to the rightfax printer seems to only recognize section breaks, while I'm only able to add a page break for the style properties. If you have any advice on how to modify the send to rightfax printer code, I'd love to hear it. Otherwise, I'm stuck with using section breaks.

Sub TestSendFax()
'
'Attribute SendFax.VB_Description = "Macro created 1/21/2003 by Peter A. Schott"
'Attribute SendFax.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.SendFax"
'
' SendFax Macro
' Macro created 1/21/2003 by Peter A. Schott
'
'Remove comments from appropriate lines for your configuration
'Adjust FaxPrinter variable for your RightFAX Printer (without prompts)
Dim TotalSec, i, CurrentSection
Dim OldPrinter 'Used to store old printer name
Dim FaxPrinter 'Can be customized for RightFAX Printer (no messages) name
FaxPrinter = "my fax printer name"

TotalSec = Selection.Information(wdNumberOfPagesInDocument)
OldPrinter = ActivePrinter
Application.ActivePrinter = FaxPrinter

For i = 1 To TotalSec
CurrentSection = "s"
ActiveDocument.PrintOut copies:=1, Range:=wdPrintFromTo, from:=CurrentSection, to:=CurrentSection
Next i

Application.ActivePrinter = OldPrinter
End Sub

[macropod]

Hi mangoagent,

There's nothing in your code that I can see to indicate any dependency on Section breaks. Furthermore, the only reason I can see for printing the document as a series of one page print jobs is if the RightFAX driver can't handle more or you need it to append a cover sheet to each page. Accordingly, with a 'page break before' Heading 1 format, you should be able to use:
Sub TestSendFax()
'Define variables for page counts, current printer name, RightFAX printer name.
Dim i As Long, OldPrinter As String, FaxPrinter As String
FaxPrinter = "My RightFAX printer name"
With Application
' store current printer name
OldPrinter = .ActivePrinter
' switch to fax printer
.ActivePrinter = FaxPrinter
'Print each page as a separate print job
For i = 1 To .ComputeStatistics(wdStatisticPages)
.PrintOut Copies:=1, Range:=wdPrintFromTo, from:=i, To:=i
Next i
End With
'restore original printer
.ActivePrinter = OldPrinter
End With
End Sub
or
Sub TestSendFax()
'Define variables for current printer name, RightFAX printer name.
Dim OldPrinter As String, FaxPrinter As String
FaxPrinter = "My RightFAX printer name"
With Application
' store current printer name
OldPrinter = .ActivePrinter
' switch to fax printer
.ActivePrinter = FaxPrinter
'Print the document as a single print job
.ActiveDocument.Printout
'restore original printer
.ActivePrinter = OldPrinter
End With
End Sub