Using a Word macro for duplex printing of booklets

[Jon Rumley]

Please forgive if I am in the wrong place! This is new to me.

I have installed the macro for booklet printing
(http://word.mvps.org/FAQs/MacrosVBA/BookletMacro.htm) and have a problem. I
am using Word 2000 (9.0.6926 SP-3) with Windows XP Pro, prininting to a
workgroup printer.
The duplex printout on my Xerox Phaser 8400 DP flips the page so the
backside is upside down in relation to the front side and page 2 is on the
back of the last page rather than page 1. If the printer box came up before
printing, I could manually fix that, but it does not.

Can you help?

Jon - (e-mail address removed)

Here is the macro:

Option Explicit

Dim PageNum As Long, NumPages As Long, XtraPages As Long, MyRange As Range,
_
PagestoPrint As String, OddPagesToPrint As String, EvenPagesToPrint As
String

Sub Booklet2000DuplexPrinter()
NumCopies = Inputbox "
NumPages = Selection.Information(wdNumberOfPagesInDocument)
'If number of pages not a multiple of 4, add manual page breaks at the
end
If NumPages Mod 4 > 0 Then Call AddExtraPages
'Put the pages to be printed into a single string, in the correct order
Call GetPagesToPrintDuplex
'Print
Call PrintPages(PagestoPrint)
'If any page breaks were added, delete them again
If XtraPages > 0 Then Call DeleteExtraPages
Call ClearVariables
End Sub


--------------------------------------------------------------------------------

Sub Booklet2000SimplexPrinter()
NumPages = Selection.Information(wdNumberOfPagesInDocument)
'If number of pages not a multiple of 4, add manual page breaks at the
end
If NumPages Mod 4 > 0 Then Call AddExtraPages
'Put the pages to be printed into a single string, in the correct order
Call GetPagesToPrintSimplex
Call PrintPages(OddPagesToPrint)
MsgBox "Please turn the paper over and press OK when you'r ready to
print"
Call PrintPages(EvenPagesToPrint)
'If any page breaks were added, delete them again
If XtraPages > 0 Then Call DeleteExtraPages
Call ClearVariables
End Sub


--------------------------------------------------------------------------------

Sub AddExtraPages()
'Adds page breaks to make the number of pages a multiple of 4
XtraPages = 4 - NumPages Mod 4
For PageNum = 1 To XtraPages
Set MyRange = ActiveDocument.Range
MyRange.Collapse wdCollapseEnd
MyRange.InsertBreak Type:=wdPageBreak
Next PageNum
NumPages = Selection.Information(wdNumberOfPagesInDocument)
End Sub


--------------------------------------------------------------------------------

Sub GetPagesToPrintDuplex()
For PageNum = 1 To NumPages / 2
If Len(PagestoPrint) > 0 Then PagestoPrint = PagestoPrint & ","
If PageNum Mod 2 = 1 Then
'odd page
PagestoPrint = PagestoPrint & (NumPages + 1 - PageNum) & "," &
PageNum
Else
' even page
PagestoPrint = PagestoPrint & PageNum & "," & (NumPages + 1 -
PageNum)
End If
Next PageNum
End Sub


--------------------------------------------------------------------------------

Sub GetPagesToPrintSimplex()
For PageNum = 1 To NumPages / 2
If PageNum Mod 2 = 1 Then
'odd page
If Len(OddPagesToPrint) > 0 Then OddPagesToPrint = _
OddPagesToPrint & ","
OddPagesToPrint = OddPagesToPrint & (NumPages + 1 - PageNum) & _
"," & PageNum
Else
'even page
If Len(EvenPagesToPrint) > 0 Then EvenPagesToPrint = _
EvenPagesToPrint & ","
EvenPagesToPrint = EvenPagesToPrint & PageNum & "," & _
(NumPages + 1 - PageNum)
End If
Next PageNum
End Sub


--------------------------------------------------------------------------------

Sub PrintPages(PagestoPrint As String)
Dim Pos As Long, PagesToPrintChunk As String, TestPages As Variant

'The 'pages to print' string can only be a maximum of 256 characters long
'(Word limitation). If > 256 characters, prints it in smaller chunks
'(otherwise just prints it)
Do While Len(PagestoPrint) > 256
PagesToPrintChunk = Left$(PagestoPrint, 256)
'Strip the chunk string so it ends before the final comma
Pos = InStrRev(PagesToPrintChunk, ",")
PagesToPrintChunk = Left$(PagesToPrintChunk, Pos - 1)
'find out how many pages are now listed in the string (needs to be a
multiple of 4)
TestPages = Split(PagesToPrintChunk, ",")
NumPages = UBound(TestPages) + 1
'If not a multipke of 4, removes some page numbers so that it is
If NumPages Mod 4 > 0 Then
For PageNum = 1 To NumPages Mod 4
Pos = InStrRev(PagesToPrintChunk, ",")
PagesToPrintChunk = Left$(PagesToPrintChunk, Pos - 1)
Next
End If
Application.PrintOut Pages:=PagesToPrintChunk, _
Range:=wdPrintRangeOfPages, Background:=False
'Strip main string so it starts just after the same comma
PagestoPrint = Mid$(PagestoPrint, Pos + 1)
Loop

Application.PrintOut Pages:=PagestoPrint, _
Range:=wdPrintRangeOfPages, Background:=False

End Sub


--------------------------------------------------------------------------------

Sub DeleteExtraPages()
'If manual page breaks were added earlier, deletes them again
Set MyRange = ActiveDocument.Range
MyRange.Collapse wdCollapseEnd
MyRange.MoveStart unit:=wdCharacter, Count:=-(XtraPages + 1)
MyRange.Delete
End Sub


--------------------------------------------------------------------------------

Sub ClearVariables()
Set MyRange = Nothing
PageNum = 0
NumPages = 0
XtraPages = 0
PagestoPrint = vbNullString
OddPagesToPrint = vbNullString
EvenPagesToPrint = vbNullString
End Sub