Hi Doug, I have managed to achieve my goal as follows:
I use a form to collect amount of pages per signatue ( I check for Mod
4 of this value to ensure the booklet has the correct amount of pages
) as follows:
Private Sub cmdOK_Click()
If fCheckPages Then
If Me.optDuplex Then
Call Booklet2000DuplexPrinter(txtintSigNum)
Else
Call Booklet2000SimplexPrinter(txtintSigNum)
End If
Unload Me
Else
Call UserForm_Initialize
End If
End Sub
Private Sub UserForm_Initialize()
Me.optDuplex = True
Me.optSimplex = False
Me.txtintSigNum = 20
End Sub
Private Function fCheckPages() As Boolean
fCheckPages = False
If Me.txtintSigNum Mod 4 > 0 Then 'Not divisible by 4
MsgBox "You must enter a number that is divisible by 4 for the
amount of pages per signature." & vbCrLf & vbCrLf & _
"Word will automatically add blank pages at the end of the
document " & _
"to cope with an uneven amount of pages within the
document", vbExclamation, "Signature Error"
fCheckPages = False
Else
fCheckPages = True
End If
End Function
The code for printing the booklet signatures follows:
Option Explicit
Dim intSigNum As Integer, intSigNumDone As Integer, intI As Integer
Dim PageNum As Long, NumPages As Long, XtraPages As Long
Dim MyRange As Range
Dim PagestoPrint As String, OddPagesToPrint As String,
EvenPagesToPrint As String
Sub Booklet2000DuplexPrinter(intSigNumPages As Integer)
NumPages = Selection.Information(wdNumberOfPagesInDocument)
'If number of pages not a multiple of number of signature pages,
add manual page breaks at the end
If NumPages Mod intSigNumPages > 0 Then Call
AddExtraPages(intSigNumPages)
intSigNum = NumPages / intSigNumPages
'loop through the signatures
For intI = 1 To intSigNum
'Put the pages to be printed into a single string, in the correct
order
Call GetPagesToPrintDuplex(intSigNumPages)
'Print
Call PrintPages(PagestoPrint)
'clear pages to print variable
PagestoPrint = vbNullString
'increment the pages to print by last amount printed
intSigNumDone = intSigNumDone + intSigNumPages
Next intI
'If any page breaks were added, delete them again
If XtraPages > 0 Then Call DeleteExtraPages
Call ClearVariables
End Sub
Sub Booklet2000SimplexPrinter(intSigNumPages As Integer)
NumPages = Selection.Information(wdNumberOfPagesInDocument)
'If number of pages not a multiple of number of signature pages,
add manual page breaks at the end
If NumPages Mod intSigNumPages > 0 Then Call
AddExtraPages(intSigNumPages)
intSigNum = NumPages / intSigNumPages
'loop through the signatures
For intI = 1 To intSigNum
'Put the pages to be printed into a single string, in the correct
order
Call GetPagesToPrintSimplex(intSigNumPages)
Call PrintPages(OddPagesToPrint)
'clear pages to print variable
PagestoPrint = vbNullString
'increment the pages to print by last amount printed
intSigNumDone = intSigNumDone + intSigNumPages
Next intI
MsgBox "Please turn the paper over and press OK when you're ready
to print"
For intI = 1 To intSigNum
'Put the pages to be printed into a single string, in the correct
order
Call GetPagesToPrintSimplex(intSigNumPages)
Call PrintPages(EvenPagesToPrint)
'clear pages to print variable
PagestoPrint = vbNullString
'increment the pages to print by last amount printed
intSigNumDone = intSigNumDone + intSigNumPages
Next intI
'If any page breaks were added, delete them again
If XtraPages > 0 Then Call DeleteExtraPages
Call ClearVariables
End Sub
Sub AddExtraPages(intSigNumPages)
'Adds page breaks to make the number of pages a multiple of 4
XtraPages = intSigNumPages - NumPages Mod intSigNumPages
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(intSigNumPages As Integer)
For PageNum = 1 To intSigNumPages / 2
If Len(PagestoPrint) > 0 Then PagestoPrint = PagestoPrint & ","
If PageNum Mod 2 = 1 Then
'odd page
PagestoPrint = PagestoPrint & (intSigNumPages + intSigNumDone +
1 - PageNum) & "," & PageNum + intSigNumDone
Else
' even page
PagestoPrint = PagestoPrint & PageNum + intSigNumDone & "," &
(intSigNumPages + intSigNumDone + 1 - PageNum)
End If
Next PageNum
End Sub
Sub GetPagesToPrintSimplex(intSigNumPages As Integer)
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
intSigNum = 0
intSigNumDone = 0
PagestoPrint = vbNullString
OddPagesToPrint = vbNullString
EvenPagesToPrint = vbNullString
End Sub
Thanks for your help though...
Stephen
