Macros for booklet printing

Article contributed by Richard Keijzer and Dave Rado

Note that Word 2002 (part of Office XP), has the built-in ability to print booklets with automatically numbered pages.

Limitation: The macro-based method doesn't allow for page numbering with multiple restarts. Using the method described in the article: Booklet printing, you can (for instance) have front matter paginated with lowercase roman numerals followed by the document body paginated with Arabic numerals followed by appendixes paginated separately with A-1, A-2, B-1, B-2, etc., and the method still works, whereas the following macros won't allow you to do this (because of a limitation of Word's Print dialog).

On the other hand, the macros save time, and also allow you to duplex a booklet in two passes to the printer, whereas the manual method requires four. (Only an issue if you want to print it in-house).

Word 2000

Word 2000 allows you to print 2 pages per sheet. Before starting on your booklet, you need to:

The Booklet2000DuplexPrinter() macro puts the page numbers into a single string, in the required order, and prints using that string. If the number of pages in the document is not a multiple of 4, it first inserts the required number of temporary page breaks so that it is, then deletes them after printing.

If the “pages to print” string is longer than 256 characters (which it will be if the booklet is more than 88 pages long), it chops the string into chunks and prints the chunks separately (making sure that number of pages listed in each “chunk” is a multiple of 4).

The Booklet2000SimplexPrinter() macro is very similar, but it prints the “odd” sheets in one pass (that is, pages 1 and 20 on one sheet, then 3 and 18, and so on); then it displays a message box so you can turn the paper in the printer over, before printing the “even” sheets on the reverse side of the paper (pages 2 and 19, then 4 and 17 and so on).

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

If you get stuck see attached sample:

If you want to print multiple copies

Wherever the macro says:

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

... modify it to say:

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

Where “2” is the number of copies you want to print.

Collate = False means you will have to collate it manually; if you would rather not have to do this, you can change to it say Collate:=True; but that would dramatically increase print times (and may cause the printer to seize up, if it's a big job). If Collate is switched on in Word, the printer has to process every copy of every page from scratch; whereas otherwise it only has to process the first copy and can print the rest at high speed. High-end printers can do the collating at their end, and if you have such a printer, that gives you the best of both worlds (let the printer, rather than Word, do the collating).

If you would like the macro to ask you how many copies you want, each time you run it, you could add the following code:

At the very top, where it says Dim, add a NumCopies variable, as follows:

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

At the start of the Booklet2000DuplexPrinter() and/or the Booklet2000SimplexPrinter() macros, insert the following:

NumCopies = InputBox("How many copies would you like to print?", _
        "Type number of copies", "1")

and wherever the macro says:

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

Modify it to say:

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