How do i print single image on centrefold of booklet

E

EddieE

Hi folks, need to print image in centre pages of booklet, spanning both
pages. Anyone any ideas how I go about this?
 
D

daneel

I developed a solution that works for me, though it's rather a
roundabout method.

I use the free PDFCreator program, which can take command line arguments
and can combine multiple jobs into a single pdf, and use a macro to
print the centrefold at the right place in the document.

The macro is a modified version of that found at
http://word.mvps.org/faqs/MacrosVBA/BookletMacro.htm

Here's how is works:

Download PDFCreator from http://sourceforge.net/projects/pdfcreator/
(version with Ghostscript included)

Install PDFCreator.

Put PrintPDF.vbs into C:\

Open Word.
Tools > Options > Security > Macro Security… > Security Level > Medium

In the same folder as the document to print, create a file
centerpage.doc which contains just the centre (landscape) page.

Open the document to print.
File > Page Setup > Landscape, 2 Pages per sheet

Tools > Macro > Macros > Macros in > document to print. This is
important otherwise the macros get put in Normal.doc rather than saved
with the document.

Macro name > Booklet
Create

File Import > BookletWithCentrefold.bas

File > Save

Tools > Macro > Macros > Booklet2000DuplexPrinter > Run

This creates a file with the same name as the document and in the same
folder, but with file type pdf.

Acrobat Reader is called to open the pdf file from where it can be
printed, having made sure that the printer properties are set to
landscape duplex.

When you reload the document you will be requested to Enable Macros for
that document.

After closing Word there may be two WINWORD.EXE processes still running.
Use Task Manager (Ctrl-Alt-Del) to terminate these.

Let us know if this works for you.

Dan

Hi folks, need to print image in centre pages of booklet, spanning both
pages. Anyone any ideas how I go about this?
Click to expand...

Attribute VB_Name = "BookletWithCentrefold"
Option Explicit

Dim PageNum As Long, NumPages As Long, XtraPages As Long, MyRange As Range, _
PagestoPrint As String, OddPagesToPrint As String, EvenPagesToPrint As String
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long
Dim wdo ' As Word.Application
Dim sPrevPrinter As String
Dim Word ' As Application
Dim Document '
Dim docs '
Dim lngCount As Long


Sub Booklet2000DuplexPrinter()
'/// Change the output file name here! ///
sPDFName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) & ".pdf"
sPDFPath = ActiveDocument.Path & Application.PathSeparator
Set pdfjob = New PDFCreator.clsPDFCreator

'Make sure the PDF printer starts
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "Error!"
Exit Sub
End If

'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

NumPages = Selection.Information(wdNumberOfPagesInDocument)
'If number of pages not a multiple of 2, add manual page breaks at the end
If NumPages Mod 2 > 0 Then Call AddExtraPages
'delete output file in case it already exists
' Kill "C:\Booklet.pdf"
'remember active printer; change to PDFCreator
Set Word = CreateObject("Word.Application")
Set wdo = CreateObject("Word.Application")
sPrevPrinter = wdo.ActivePrinter
Set docs = wdo.Documents
Word.ActivePrinter = "PDFCreator"
' End With

'Put the pages to be printed into a string
Call GetPagesToPrintDuplex
'Print
Call PrintPages(PagestoPrint)
' Print centre page
Call PrintCentrePage
'If any page breaks were added, delete them again
If XtraPages > 0 Then Call DeleteExtraPages
Call CombineJobs
'restore previous Acitve Printer
Word.ActivePrinter = sPrevPrinter
Call ClearVariables
MsgBox sPDFPath & sPDFName & " has been created"
'lngCount = Shell("AcroRd32.exe " & sPDFPath & sPDFName, vbNormalFocus)
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 2
XtraPages = 2 - NumPages Mod 2
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 PrintCentrePage()
Set Document = Documents.Open(sPDFPath & "centrepage.doc", ReadOnly:=True)
'Set Document = Documents.Open(FileName:="C:\lcp.doc", ReadOnly:=True)
Application.PrintOut Background:=False, Range:=wdPrintAllPages
Document.Close wdDoNotSaveChanges
'MsgBox "Centre page printed"
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 multiple 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
'MsgBox "Pages: " & PagestoPrintChunk
'Strip main string so it starts just after the same comma
PagestoPrint = Mid$(PagestoPrint, Pos + 1)
Loop
'print final 88 pages or less
Application.PrintOut Pages:=PagestoPrint, _
Range:=wdPrintRangeOfPages, Background:=False
'MsgBox "Pages: " & PagestoPrint
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

Sub CombineJobs()
'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 2
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
pdfjob.cCombineAll
' Wait until the print job has entered the queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
'Sleep 100
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
' Sleep 100 ' We have to be sure that PDFCreator has left the building
DoEvents
lngCount = 0
Do Until Not ProcessExists("PDFCreator.exe")
lngCount = lngCount + 1
If lngCount < 4 Then
'Sleep 250
Else
Call CloseAPP_B("PDFCreator.exe") ' Kill it
End If
Loop
End Sub


Private Function CloseAPP_B(AppNameOfExe As String)
'No frills killer
' Source: http://visualbasic.ittoolbox.com/do...-a/closing-application-through-vba-event-1975
Dim oProcList As Object
Dim oWMI As Object
Dim oProc As Object

' step 1: create WMI object instance:
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
' step 2: create object collection of Win32 processes:
Set oProcList = oWMI.InstancesOf("win32_process")
' step 3: iterate through the enumerated collection:
For Each oProc In oProcList ' Kill 'em all
If UCase(oProc.Name) = UCase(AppNameOfExe) Then oProc.Terminate (0)
Next 'oProc In oProcList
Else
'report error
MsgBox "Killing """ & AppNameOfExe & """ - Can't create WMI Object.", vbOKOnly + vbCritical, "CloseAPP_B"
End If

' step 4: clear out the objects:
Set oProcList = Nothing
Set oWMI = Nothing
End Function

' From that, I derived this function:

Private Function ProcessExists(strProcess As String) As Boolean
' Based on CloseAPP_B
Dim strUProc As String
Dim oProcList As Object
Dim oWMI As Object
Dim oProc As Object

' step 1: create WMI object instance:
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
' step 2: create object collection of Win32 processes:
Set oProcList = oWMI.InstancesOf("win32_process")
' step 3: iterate through the enumerated collection:
ProcessExists = True ' Assume it's there; makes for simpler code
strUProc = UCase(strProcess)
For Each oProc In oProcList
If UCase(oProc.Name) = strUProc Then GoTo FoundIt
Next 'oProc In oProcList
ProcessExists = False
Else
'report error
MsgBox "ProcessExists(" & strProcess & "): Can't create WMI Object.", vbOKOnly + vbCritical, "ProcessExists"
End If

' step 4: clear out the objects:
FoundIt:
Set oProcList = Nothing
Set oWMI = Nothing

End Function

' Then, in my PDFCreator module, I use code like this:

' Wait until the print job has entered the queue
'strStatus = strObjName & " - Waiting for queueing job"
'Do Until myPDFCreator.cCountOfPrintjobs = 1
'DoEvents
'Sleep 100
'Loop
'myPDFCreator.cPrinterStop = False

' Wait until the PDF file shows up
'Do Until Dir(theFileRoot & OutYear & OutMonth & OutDay & outName) <> ""
'Sleep 100
'DoEvents
'Loop

'myPDFCreator.cClose ' This where timing issues arise
'Set myPDFCreator = Nothing



'End Function


Dim WshShell, aPDF
Set WshShell = WScript.CreateObject("WScript.Shell")

aPDF = WshShell.RegRead("HKCR\.pdf\")
aPDF = WshShell.RegRead("HKCR\" & aPDF & "\CurVer\")
aPDF = WshShell.RegRead("HKCR\" & aPDF & "\shell\print\command\")

for i=0 to Wscript.Arguments.Count-1
aPDF = Replace(aPDF,"%1",Wscript.Arguments(i))
Set oExec = WshShell.Exec(aPDF)
next
 
E

EddieE

Hi Dan thanks for the reply,

I've been trying to follow your instructions but am stuck when it comes to
file > Import > BookletWithCentrefold.bas

File save

Where do I do this from? Within word or macros? where is
BookletWithCentrefold.bas located to import it?

Thanks for helping on this

Eddie
 
D

daneel

Ah! I attached it to my reply to this newsgroup but it gets stripped off
somewhere. So here it is. I will send the vb script in a separate reply.

BookletWithCentrefold.bas begins below:

Attribute VB_Name = "BookletWithCentrefold"
Option Explicit

Dim PageNum As Long, NumPages As Long, XtraPages As Long, MyRange As
Range, _
PagestoPrint As String, OddPagesToPrint As String, EvenPagesToPrint
As String
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long
Dim wdo ' As Word.Application
Dim sPrevPrinter As String
Dim Word ' As Application
Dim Document '
Dim docs '
Dim lngCount As Long


Sub Booklet2000DuplexPrinter()
'/// Change the output file name here! ///
sPDFName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
& ".pdf"
sPDFPath = ActiveDocument.Path & Application.PathSeparator
Set pdfjob = New PDFCreator.clsPDFCreator

'Make sure the PDF printer starts
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "Error!"
Exit Sub
End If

'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

NumPages = Selection.Information(wdNumberOfPagesInDocument)
'If number of pages not a multiple of 2, add manual page breaks at
the end
If NumPages Mod 2 > 0 Then Call AddExtraPages
'delete output file in case it already exists
' Kill "C:\Booklet.pdf"
'remember active printer; change to PDFCreator
Set Word = CreateObject("Word.Application")
Set wdo = CreateObject("Word.Application")
sPrevPrinter = wdo.ActivePrinter
Set docs = wdo.Documents
Word.ActivePrinter = "PDFCreator"
' End With

'Put the pages to be printed into a string
Call GetPagesToPrintDuplex
'Print
Call PrintPages(PagestoPrint)
' Print centre page
Call PrintCentrePage
'If any page breaks were added, delete them again
If XtraPages > 0 Then Call DeleteExtraPages
Call CombineJobs
'restore previous Acitve Printer
Word.ActivePrinter = sPrevPrinter
Call ClearVariables
MsgBox sPDFPath & sPDFName & " has been created"
'lngCount = Shell("AcroRd32.exe " & sPDFPath & sPDFName, vbNormalFocus)
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 2
XtraPages = 2 - NumPages Mod 2
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 PrintCentrePage()
Set Document = Documents.Open(sPDFPath & "centrepage.doc",
ReadOnly:=True)
'Set Document = Documents.Open(FileName:="C:\lcp.doc",
ReadOnly:=True)
Application.PrintOut Background:=False, Range:=wdPrintAllPages
Document.Close wdDoNotSaveChanges
'MsgBox "Centre page printed"
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 multiple 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
'MsgBox "Pages: " & PagestoPrintChunk
'Strip main string so it starts just after the same comma
PagestoPrint = Mid$(PagestoPrint, Pos + 1)
Loop
'print final 88 pages or less
Application.PrintOut Pages:=PagestoPrint, _
Range:=wdPrintRangeOfPages, Background:=False
'MsgBox "Pages: " & PagestoPrint
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

Sub CombineJobs()
'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 2
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
pdfjob.cCombineAll
' Wait until the print job has entered the queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
'Sleep 100
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
' Sleep 100 ' We have to be sure that PDFCreator has left the building
DoEvents
lngCount = 0
Do Until Not ProcessExists("PDFCreator.exe")
lngCount = lngCount + 1
If lngCount < 4 Then
'Sleep 250
Else
Call CloseAPP_B("PDFCreator.exe") ' Kill it
End If
Loop
End Sub


Private Function CloseAPP_B(AppNameOfExe As String)
'No frills killer
' Source:
http://visualbasic.ittoolbox.com/do...-a/closing-application-through-vba-event-1975
Dim oProcList As Object
Dim oWMI As Object
Dim oProc As Object

' step 1: create WMI object instance:
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
' step 2: create object collection of Win32 processes:
Set oProcList = oWMI.InstancesOf("win32_process")
' step 3: iterate through the enumerated collection:
For Each oProc In oProcList ' Kill 'em all
If UCase(oProc.Name) = UCase(AppNameOfExe) Then oProc.Terminate (0)
Next 'oProc In oProcList
Else
'report error
MsgBox "Killing """ & AppNameOfExe & """ - Can't create WMI Object.",
vbOKOnly + vbCritical, "CloseAPP_B"
End If

' step 4: clear out the objects:
Set oProcList = Nothing
Set oWMI = Nothing
End Function

' From that, I derived this function:

Private Function ProcessExists(strProcess As String) As Boolean
' Based on CloseAPP_B
Dim strUProc As String
Dim oProcList As Object
Dim oWMI As Object
Dim oProc As Object

' step 1: create WMI object instance:
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
' step 2: create object collection of Win32 processes:
Set oProcList = oWMI.InstancesOf("win32_process")
' step 3: iterate through the enumerated collection:
ProcessExists = True ' Assume it's there; makes for simpler code
strUProc = UCase(strProcess)
For Each oProc In oProcList
If UCase(oProc.Name) = strUProc Then GoTo FoundIt
Next 'oProc In oProcList
ProcessExists = False
Else
'report error
MsgBox "ProcessExists(" & strProcess & "): Can't create WMI Object.",
vbOKOnly + vbCritical, "ProcessExists"
End If

' step 4: clear out the objects:
FoundIt:
Set oProcList = Nothing
Set oWMI = Nothing

End Function

' Then, in my PDFCreator module, I use code like this:

' Wait until the print job has entered the queue
'strStatus = strObjName & " - Waiting for queueing job"
'Do Until myPDFCreator.cCountOfPrintjobs = 1
'DoEvents
'Sleep 100
'Loop
'myPDFCreator.cPrinterStop = False

' Wait until the PDF file shows up
'Do Until Dir(theFileRoot & OutYear & OutMonth & OutDay & outName) <> ""
'Sleep 100
'DoEvents
'Loop

'myPDFCreator.cClose ' This where timing issues arise
'Set myPDFCreator = Nothing



'End Function
 
D

daneel

Here's the vb script for PrintPDF.vbs :

Dim WshShell, aPDF
Set WshShell = WScript.CreateObject("WScript.Shell")

aPDF = WshShell.RegRead("HKCR\.pdf\")
aPDF = WshShell.RegRead("HKCR\" & aPDF & "\CurVer\")
aPDF = WshShell.RegRead("HKCR\" & aPDF & "\shell\print\command\")

for i=0 to Wscript.Arguments.Count-1
aPDF = Replace(aPDF,"%1",Wscript.Arguments(i))
Set oExec = WshShell.Exec(aPDF)
next


Dan
 
Top