Excel Printing VBA Code tray Selection

ProdigyOne

Board Regular
Joined
Jun 29, 2002
Messages
63
Hello:
I was wondering how i select what tray i want to print from
using Microsoft Excel (using VBA code).
Please get back to me ASAP!
Thanks
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Heres a bit of code and txt I came across. I have not had a chance to test it. It may help.

Sub ChangeTrayAndPrint()
' selects the manual page tray and prints the selected sheet(s)
Application.SendKeys "%fu%e{TAB}{DOWN}{DOWN}{TAB}m~~", True
End Sub


The sample macros above will work with the norwegian version of Excel97 together with a Canon bubblejet printer. The content of the textstring that you transfer with SendKeys may be different from computer to computer depending on the version of Excel and the installed printer. You will have to edit the above macros to make them work for you on your computer. You will find a complete list of special characters that replaces the special function keys in the built-in help for VBA, type SendKeys in a module, select the word and press the F1-key.
 
Upvote 0
Update

Here is some API code recently sent to me by Damon Ostrander for selecting printer trays.

Option Explicit
Public Type PRINTER_DEFAULTS
pDatatype As Long
pDevmode As Long
DesiredAccess As Long
End Type

Public Type PRINTER_INFO_2
pServerName As Long
pPrinterName As Long
pShareName As Long
pPortName As Long
pDriverName As Long
pComment As Long
pLocation As Long
pDevmode As Long ' Pointer to DEVMODE
pSepFile As Long
pPrintProcessor As Long
pDatatype As Long
pParameters As Long
pSecurityDescriptor As Long ' Pointer to SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type

Public Type DEVMODE
dmDeviceName As String * 32
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long
End Type

Public Const DM_DUPLEX = &H1000&
Public Const DM_IN_BUFFER = 8
Public Const DM_OUT_BUFFER = 2
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

Public Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Public Declare Function DocumentProperties Lib "winspool.drv" _
Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
ByVal hPrinter As Long, ByVal pDeviceName As String, _
ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _
ByVal fMode As Long) As Long

Public Declare Function GetPrinter Lib "winspool.drv" Alias _
"GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Byte, ByVal cbBuf As Long, pcbNeeded As Long) As Long

Public Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long

Public Declare Function SetPrinter Lib "winspool.drv" Alias _
"SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Byte, ByVal Command As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal cbLength As Long)

' ==================================================================
' SetPrinterTray
'
' Programmatically set the input source flag for the specified printer
' driver's default properties for paper input bin.
'
' Returns: True on success, False on error. (An error will also

' display a message box. This is done for informational value
' only. You should modify the code to support better error
' handling in your production application.)
'
' Parameters:
' sPrinterName - The name of the printer to be used.
'
' nBinSetting - One of the following standard settings:
' 1 = Upper
' 2 = Lower
' 3 = Middle
' 4 = Manual
' 5 = Envelope
' 6 = Envelope Manual
' 7 = Auto
' 8 = Tractor
' 9 = Small Format
' 10 = Large Format
' 11 = Large Capacity
'
' ==================================================================
Public Function SetPrinterTray(ByVal sPrinterName As String, _
ByVal nBinSetting As Long) As Boolean

Dim hPrinter As Long
Dim pd As PRINTER_DEFAULTS
Dim pinfo As PRINTER_INFO_2
Dim dm As DEVMODE

Dim yDevModeData() As Byte
Dim yPInfoMemory() As Byte
Dim nBytesNeeded As Long
Dim nRet As Long, nJunk As Long

On Error GoTo cleanup

If (nBinSetting < 1) Or (nBinSetting > 11) Then
MsgBox "Error: Tray Setting is incorrect."
Exit Function
End If

pd.DesiredAccess = PRINTER_ALL_ACCESS
nRet = OpenPrinter(sPrinterName, hPrinter, pd)
If (nRet = 0) Or (hPrinter = 0) Then
If Err.LastDllError = 5 Then
MsgBox "Access denied -- See article Q230743 for more info."
Else
MsgBox "Cannot open the printer specified " & _
"(make sure the printer name is correct)."
End If
Exit Function
End If

nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (nRet < 0) Then
MsgBox "Cannot get the size of the DEVMODE structure."
GoTo cleanup
End If

ReDim yDevModeData(nRet + 100) As Byte
nRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (nRet < 0) Then
MsgBox "Cannot get the DEVMODE structure."
GoTo cleanup
End If

Call CopyMemory(dm, yDevModeData(0), Len(dm))

If Not CBool(dm.dmFields & DM_DUPLEX) Then
MsgBox "You cannot modify the duplex flag for this printer " & _
"because it does not support duplex or the driver " & _
"does not support setting it from the Windows API."
GoTo cleanup
End If

dm.dmDefaultSource = nBinSetting
Call CopyMemory(yDevModeData(0), dm, Len(dm))

nRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
DM_IN_BUFFER Or DM_OUT_BUFFER)

If (nRet < 0) Then
MsgBox "Unable to set tray setting to this printer."
GoTo cleanup
End If

Call GetPrinter(hPrinter, 2, 0, 0, nBytesNeeded)
If (nBytesNeeded = 0) Then GoTo cleanup

ReDim yPInfoMemory(nBytesNeeded + 100) As Byte

nRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), nBytesNeeded, nJunk)
If (nRet = 0) Then
MsgBox "Unable to get shared printer settings."
GoTo cleanup
End If

Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))
pinfo.pDevmode = VarPtr(yDevModeData(0))
pinfo.pSecurityDescriptor = 0
Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

nRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)
If (nRet = 0) Then
MsgBox "Unable to set shared printer settings."
End If

SetPrinterTray = CBool(nRet)

cleanup:
If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function


Sub TestManualSetting()

' This routine tests SetPrinterTray, using it to set the Manual
' input paper tray as the default paper source

Dim Success As Boolean
Success = SetPrinterTray("\\AST-P-SSB02\ssna-516-45c", 4)
If Success Then
MsgBox "Glorious Success!"
Else
MsgBox "Miserable Failure!"
End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,240
Messages
6,170,951
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top