Print with VBA

[Gregory K. Maxey]

Hi,

I am working on a Word2007 Template AddIn to print out a document. I have
several printers and several copies of the printer drivers set up so I can
print draft, print color, print simplex, print duplex, etc. My list of
available printers looks something like this:

HP PSC 750 Draft Simplex
HP PSC 750 Draft Duplex
HP PSC 750 Color Simplex
HP PSC 750 Color Duplex

The AddIn adds a Tab to the Ribbon "Print Document." The Tab contains a
Dropdown that lists the available printers. When I select a printer in the
dropdown the document prints using the selected printer. It works, but
there is a four to five second delay before the document prints. I can't
figure out how to identify and correct the what is causing the delay. Can
anyone advise as to what is causing this delay or if there is a faster
method that I should use? Thanks.

Here is my RibbonX and code:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
onLoad="RibbonControl.Onload">
<ribbon>
<tabs>
<tab id="CT1" label="Print Document">
<group id="Grp2" label="Printers">
<dropDown id="Grp2DD1" label="Select Printer: " onAction="GetDDIndex"
getItemCount= "GetDDCount" getItemLabel="GetDDLabels">
</dropDown>
</group>
</tab>
</tabs>
</ribbon>
</customUI>

In a module named "RibbonControl" I have the following code:

Option Explicit
Private myRibbon As IRibbonUI
Private arrPrinterList As Variant

Sub Onload(ribbon As IRibbonUI)
Set myRibbon = ribbon
End Sub

Sub GetDDIndex(ByVal control As IRibbonControl, selectedID As String, _
selectedIndex As Integer)
Dim pStr As String
Select Case control.ID
Case Is = "Grp2DD1"
myRibbon.Invalidate
pStr = Application.ActivePrinter
Application.ActivePrinter = arrPrinterList(selectedIndex)
ActiveDocument.PrintOut
Application.ActivePrinter = pStr
Case Else
'Do Nothing
End Select
End Sub

Sub GetDDCount(ByVal control As IRibbonControl, ByRef count)
Select Case control.ID
Case Is = "Grp2DD1"
count = UBound(Printers.ListPrinters) + 1
Case Else
'Do Nothing
End Select
End Sub

Sub GetDDLabels(ByVal control As IRibbonControl, _
index As Integer, ByRef label)
Select Case control.ID
Case Is = "Grp2DD1"
arrPrinterList = Printers.ListPrinters 'Gets list of printers from a
function in a separate module.
label = arrPrinterList(index)
Case Else
'Do nothing
End Select
End Sub


In a module named "Printers" I have the following code taken from the Word
MVP website to create a list of printers. I added a WordBasic.SortArray line
so the list is sorted before it is displayed:

Option Explicit
Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2
Private Declare Function EnumPrinters Lib "winspool.drv" Alias
"EnumPrintersA" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
pcReturned As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) As Long

Public Function ListPrinters() As Variant
Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim StrPrinters() As String
iBufferSize = 3072
ReDim iBuffer((iBufferSize \ 4) - 1) As Long
'EnumPrinters will return a value False if the buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If Not bSuccess Then
If iBufferRequired > iBufferSize Then
iBufferSize = iBufferRequired
Debug.Print "iBuffer too small. Trying again with "; _
iBufferSize & " bytes."
ReDim iBuffer(iBufferSize \ 4) As Long
End If
'Try again with new buffer
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
End If
If Not bSuccess Then
'Enumprinters returned False
MsgBox "Error enumerating printers."
Exit Function
Else
'Enumprinters returned True, use found printers to fill the array
ReDim StrPrinters(iEntries - 1)
For iIndex = 0 To iEntries - 1
'Get the printername
strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
StrPrinters(iIndex) = strPrinterName
Next iIndex
End If
WordBasic.SortArray StrPrinters
ListPrinters = StrPrinters
End Function

 

[Jonathan West]

Hi Greg

The chances are that this is the line that slows things down

Application.ActivePrinter = arrPrinterList(selectedIndex)

Try instead the technique described in this article:

Changing the selected (current) printer in Word without changing the system
default printer
http://www.word.mvps.org/FAQs/MacrosVBA/ChangeCurPrinter.htm

 

[Gregory K. Maxey]

Jonathan,

Thanks for the reply. That isn't it. I changed my code as follows:

Sub GetDDIndex(ByVal control As IRibbonControl, selectedID As String, _
selectedIndex As Integer)
Dim pStr As String
Select Case control.ID
Case Is = "Grp2DD1"
myRibbon.Invalidate
pStr = Application.ActivePrinter
With Dialogs(wdDialogFilePrintSetup)
.Printer = arrPrinterList(selectedIndex)
.DoNotSetAsSysDefault = True
.Execute
End With
ActiveDocument.PrintOut
'This Line
' Application.ActivePrinter = pStr
'Or these lines are causing the delay.
' With Dialogs(wdDialogFilePrintSetup)
' .Printer = pStr
' .Execute
' End With
Case Else
'Do Nothing
End Select
End Sub

Without the stetted lines the printout occurs without delay. However, this
leaves the printer selected set as the Word printer. The odd thing is that
the lines causing the delay are after the ActiveDocument.Printout command.
That really doesn't make sense.

You might be able to see this for yourself with this code modified to suit
your installed printers:

Sub SeeDelay()
Dim pStr As String
pStr = Application.ActivePrinter
With Dialogs(wdDialogFilePrintSetup)
.Printer = "Send to OneNote 2007"
.DoNotSetAsSysDefault = True
.Execute
End With
ActiveDocument.PrintOut
'This Line
'Application.ActivePrinter = pStr
'Or these lines are causing the delay.
With Dialogs(wdDialogFilePrintSetup)
.Printer = pStr
.Execute
End With
End Sub

 

[Jonathan West]

Change the printout as follows

ActiveDocument.PrintOut Background:=False

This will ensure that the time-consuming change of printers doesn't happen
until after the print job has been sent to the print spooler.

As a matter of general principle, whenever my VBA programs involve printing,
I always turn background printing off unless the PrintOut command is the
last thing that needs to be done.

 

[Gregory K. Maxey]

That works!

Thanks Jonathan.

Change the printout as follows

ActiveDocument.PrintOut Background:=False

This will ensure that the time-consuming change of printers doesn't
happen until after the print job has been sent to the print spooler.

As a matter of general principle, whenever my VBA programs involve
printing, I always turn background printing off unless the PrintOut
command is the last thing that needs to be done.