Option Explicit
'//
'// WinXP / XL2000
'// For more Info look here
'// http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/prntspol_8nle.asp
'//
'// Const Before Type Declaration
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_TEST = &H4
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
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 * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long 'NT 4.0
dmICMIntent As Long 'NT 4.0
dmMediaType As Long 'NT 4.0
dmDitherType As Long 'NT 4.0
dmReserved1 As Long 'NT 4.0
dmReserved2 As Long 'NT 4.0
dmPanningWidth As Long 'Win2000
dmPanningHeight As Long 'Win2000
End Type
Declare Function DocumentProperties _
Lib "winspool.drv" _
Alias "DocumentPropertiesA" ( _
ByVal hWnd As Long, _
ByVal hPrinter As Long, _
ByVal pDeviceName As String, _
pDevModeOutput As DEVMODE, _
pDevModeInput As DEVMODE, _
ByVal fMode As Long) _
As Long
Private Declare Function PrinterProperties _
Lib "winspool.drv" ( _
ByVal hWnd As Long, _
ByVal hPrinter As Long) _
As Long
Private Declare Function OpenPrinter _
Lib "winspool.drv" _
Alias "OpenPrinterA" ( _
ByVal pPrinterName As String, _
phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) _
As Long
Private Declare Function ClosePrinter _
Lib "winspool.drv" ( _
ByVal hPrinter As Long) _
As Long
Private Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long
pDesiredAccess As Long
End Type
Dim sString As String
Dim sPrinterName As String
Dim sPrinterPort As String
Dim sPrinterFullName As String
Dim sDetails As String
Const searchText As String = " on "
Const MsgNoGo As String = "Sorry couldn't show Printer Properties!"
'// The only way I am aware of to change the Tray Type is
'// to Display the Printer Properties dialog box.
'// The DeviceName argument is the DeviceName property of the Printer object or
'// an item in the Printers collection.
'// ParentHWnd is the handle of the window that owns the dialog box.
'// Just use 0 > DeskTop
'// Returns True if the function succeeds.
Function ShowPrinterProperties(ByVal DeviceName As String, _
ByVal ParentHWnd As Long) As Boolean
Dim PrinterDef As PRINTER_DEFAULTS
Dim hPrinter As Long
Const PRINTER_ALL_ACCESS = &HF000C
PrinterDef.pDesiredAccess = PRINTER_ALL_ACCESS
If OpenPrinter(DeviceName, hPrinter, PrinterDef) Then
ShowPrinterProperties = PrinterProperties(ParentHWnd, hPrinter)
ClosePrinter hPrinter
End If
End Function
Sub Tester()
'// WinXP / XL2000
'// Note: this is the name of the printer I use
'// For me it was Canon BJC-5000
'// Now you will have to use sendkeys to change to the
'// Tray type....experiment to get the correct ones
'SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{DOWN}~"
'// Changes my prt from A4 - A3
If Not ShowPrinterProperties(fPrinterName, 0) Then
MsgBox MsgNoGo
End If
'"Canon BJC-5000 Series", 0
End Sub
Function fPrinterName() As String
'// ActivePrinter yields a name of the form "Printer XYZ on LPT1" while the
'// DeviceCapabilities function requires a printer name and port.
sString = ActivePrinter
sPrinterName = Left(sString, InStr(1, sString, searchText) - 1)
sPrinterPort = Right(sString, Len(sString) - Len(sPrinterName) - Len(searchText))
fPrinterName = sPrinterName
End Function