Public Enum PrinterOrientationConstants OrientPortrait = 1 OrientLandscape = 2 End Enum Private 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 End Type Private Type PRINTER_DEFAULTS pDataType As String pDevMode As Long DesiredAccess As Long End Type Private 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 pSepFile As Long pPrintProcessor As Long pDataType As Long pParameters As Long pSecurityDescriptor As Long 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 Private Const DM_IN_BUFFER As Long = 8 Private Const DM_OUT_BUFFER As Long = 2 Private Const DM_ORIENTATION As Long = &H1 Private Const PRINTER_ACCESS_ADMINISTER As Long = &H4 Private Const PRINTER_ACCESS_USE As Long = &H8 Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000 Private Const PRINTER_ALL_ACCESS = _ (STANDARD_RIGHTS_REQUIRED _ Or PRINTER_ACCESS_ADMINISTER Or _ PRINTER_ACCESS_USE) Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, _ phPrinter As Long, pDefault As Any) As Long Private Declare Function ClosePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Function DocumentProperties Lib "winspool.drv" _ Alias "DocumentPropertiesA" (ByVal hWnd As Long, _ ByVal hPrinter As Long, ByVal pDeviceName As String, _ pDevModeOutput As Any, pDevModeInput As Any, ByVal fmode As Long) As Long Private Declare Function GetPrinter Lib "winspool.drv" _ Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _ pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long Private Declare Function SetPrinter Lib "winspool.drv" _ Alias "SetPrinterA" (ByVal hPrinter As Long, _ ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long Public Function SetDefaultPrinterOrientation(ByVal eOrientation As PrinterOrientationConstants) As Boolean Dim bDevMode() As Byte Dim bPrinterInfo2() As Byte Dim hPrinter As Long Dim nSize As Long Dim sPrnName As String Dim dm As DEVMODE Dim pd As PRINTER_DEFAULTS Dim pi2 As PRINTER_INFO_2 On Error GoTo ErrHandler 'Get device name of default printer sPrnName = Printer.DeviceName 'PRINTER_ALL_ACCESS required under NT, because we're 'going to call SetPrinter pd.DesiredAccess = PRINTER_ALL_ACCESS 'Get a handle to the printer. If OpenPrinter(sPrnName, hPrinter, pd) Then 'Get number of bytes required 'for PRINTER_INFO_2 structure Call GetPrinter(hPrinter, 2&, 0&, 0&, nSize) 'Create a buffer of the required size ReDim bPrinterInfo2(1 To nSize) As Byte 'Fill buffer with structure Call GetPrinter(hPrinter, 2, bPrinterInfo2(1), nSize, nSize) 'Copy fixed portion of structure into VB Type variable Call CopyMemory(pi2, bPrinterInfo2(1), Len(pi2)) 'Get number of bytes required for DEVMODE structure nSize = DocumentProperties(0&, hPrinter, _ sPrnName, 0&, 0&, 0) 'Create a buffer of the required size ReDim bDevMode(1 To nSize) 'If PRINTER_INFO_2 points to a DEVMODE structure, 'copy it into our buffer If pi2.pDevMode Then Call CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm)) Else 'Otherwise, call DocumentProperties to get a 'DEVMODE structure Call DocumentProperties(0&, hPrinter, sPrnName, _ bDevMode(1), 0&, DM_OUT_BUFFER) End If 'Copy fixed portion of structure into VB Type variable Call CopyMemory(dm, bDevMode(1), Len(dm)) With dm 'Set new orientation .dmOrientation = eOrientation .dmFields = DM_ORIENTATION End With 'Copy our Type back into buffer Call CopyMemory(bDevMode(1), dm, Len(dm)) 'Set new orientation Call DocumentProperties(0&, hPrinter, sPrnName, _ bDevMode(1), bDevMode(1), DM_IN_BUFFER Or _ DM_OUT_BUFFER) 'Point PRINTER_INFO_2 at our modified DEVMODE pi2.pDevMode = VarPtr(bDevMode(1)) 'Set new orinetation system wide Call SetPrinter(hPrinter, 2, pi2, 0&) 'Clean up and exit Call ClosePrinter(hPrinter) SetDefaultPrinterOrientation = True Else SetDefaultPrinterOrientation = False End If Exit Function ErrHandler: MsgBox "The following error occurred while resetting printer orientation." & vbCrLf & vbCrLf & _ "Error " & Err.Number & " - " & Err.Description, _ vbExclamation SetDefaultPrinterOrientation = False End Function