Beispiel:

Option Explicit
 
Public Const CCHDEVICENAME          As Long = 32
Public Const CCHFORMNAME            As Long = CCHDEVICENAME
 
Public Type DefPrinter_Settings_t
  lOrientation                        As Long
  lPrintQuality                       As Long
  lTrueTypeOption                     As Long
  lColorOrMonochrome                  As Long
  lScaleFactor                        As Long
  lFields                             As Long
  lDuplex                             As Long
  lYResolution                        As Long
  lCopies                             As Long
  sDeviceName                         As String
  sOrientation                        As String
  sPrintQuality                       As String
  sTrueTypeOption                     As String
  sColorOrMonochrome                  As String
  sScaleFactor                        As String
  sCollating                          As String
  sDuplex                             As String
  sYResolution                        As String
  sCopies                             As String
End Type
 
Public Type DEVMODE2
  dmDeviceName(1 To CCHDEVICENAME)    As Byte
  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(1 To CCHFORMNAME)        As Byte
  dmUnusedPadding                     As Integer
  dmBitsPerPel                        As Integer
  dmPelsWidth                         As Long
  dmPelsHeight                        As Long
  dmDisplayFlags                      As Long
  dmDisplayFrequency                  As Long
End Type
 
Public Declare Function OpenPrinter _
    Lib "winspool.drv" Alias _
    "OpenPrinterA" _
    (ByVal pPrinterName As String, _
    phPrinter As Long, _
    ByVal pDefault 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, _
    pDevModeOutput As Any, _
    pDevModeInput As Any, _
    ByVal fMode As Long) As Long
 
Public Declare Function ClosePrinter _
    Lib "winspool.drv" _
    (ByVal hPrinter As Long) As Long
 
Public Declare Sub CopyMemory _
    Lib "kernel32" Alias _
    "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
Public Function DefaultPrinterSettings( _
                uPrn As DefPrinter_Settings_t) As Boolean
  '// -----------------------------------------------------
  '// Methode:   | Einstellungen des Standard-Druckers
  '//            | ermitteln; benötigt Hilfsf. ByteToString
  '// -----------------------------------------------------
  '// Parameter: | uPrn - Strukturvariable
  '// -----------------------------------------------------
  '// Rückgabe:  | gefüllte Strukturvariable
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispiel:
  '// -----------------------------------------------------
  '// Dim uPrn As DefPrinter_Settings_t
  '// If DefaultPrinterSettings(uPrn) = True Then
  '//   With uPrn
  '//     Debug.Print "Drucker; "; .sDeviceName
  '//     Debug.Print "Sortierung: "; .sCollating
  '//     Debug.Print "Farbe: "; .sColorOrMonochrome
  '//     Debug.Print "Kopien: "; .sCopies
  '//     Debug.Print "Duplex: "; .sDuplex
  '//     Debug.Print "Orientierung: "; .sOrientation
  '//     Debug.Print "Druckqualität: "; .sPrintQuality
  '//     Debug.Print "Skalierfaktor: "; .sScaleFactor
  '//     Debug.Print "TrueType Option: "; .sTrueTypeOption
  '//     Debug.Print "Y-Auflösung: "; .sYResolution
  '//   End With
  '// End If
  '// -----------------------------------------------------
  Const NULLPTR               As Long = 0&
  Const DM_COPY               As Long = 2
  Const DM_OUT_BUFFER         As Long = DM_COPY
  Const DMORIENT_PORTRAIT     As Long = 1
  Const DMORIENT_LANDSCAPE    As Long = 2
  Const DMRES_DRAFT           As Long = (-1)
  Const DMRES_LOW             As Long = (-2)
  Const DMRES_MEDIUM          As Long = (-3)
  Const DMRES_HIGH            As Long = (-4)
  Const DMTT_BITMAP           As Long = 1
  Const DMTT_DOWNLOAD         As Long = 2
  Const DMTT_SUBDEV           As Long = 3
  Const DMCOLOR_COLOR         As Long = 2
  Const DMCOLOR_MONOCHROME    As Long = 1
  Const DMCOLLATE_FALSE       As Long = 0
  Const DMCOLLATE_TRUE        As Long = 1
  Const DM_COLLATE            As Long = &H8000
  Const DM_DUPLEX             As Long = &H1000&
  Const DMDUP_SIMPLEX         As Long = 1
  Const DMDUP_VERTICAL        As Long = 2
  Const DMDUP_HORIZONTAL      As Long = 3
 
  Dim uDevMode                As DEVMODE2
  Dim abtDevMode()            As Byte
  Dim sPrinterName            As String
  Dim sTmpValue               As String
  Dim lPrinter                As Long
  Dim lSize                   As Long
 
  sPrinterName = Printer.DeviceName
  If OpenPrinter(sPrinterName, lPrinter, NULLPTR) Then
    lSize = DocumentProperties(NULLPTR, _
        lPrinter, _
        sPrinterName, _
        NULLPTR, _
        NULLPTR, _
        0)
    ReDim abtDevMode(1 To lSize)
    lSize = DocumentProperties(NULLPTR, _
        lPrinter, _
        sPrinterName, _
        abtDevMode(1), _
        NULLPTR, _
        DM_OUT_BUFFER)
    Call CopyMemory(uDevMode, abtDevMode(1), Len(uDevMode))
    '// ---------------------------------------------------
    '// Druckername
    '// ---------------------------------------------------
    uPrn.sDeviceName = ByteToString(uDevMode.dmDeviceName)
    '// ---------------------------------------------------
    '// Orientierung
    '// ---------------------------------------------------
    uPrn.lOrientation = uDevMode.dmOrientation
    Select Case uPrn.lOrientation
    Case DMORIENT_PORTRAIT:
      uPrn.sOrientation = "Hochformat"
    Case DMORIENT_LANDSCAPE:
      uPrn.sOrientation = "Querformat"
    Case Else:
      uPrn.sOrientation = "nicht definiert"
    End Select
    '// ---------------------------------------------------
    '// Druckqualität
    '// ---------------------------------------------------
    uPrn.lPrintQuality = uDevMode.dmPrintQuality
    Select Case uPrn.lPrintQuality
    Case DMRES_DRAFT:
      uPrn.sPrintQuality = "Konzept"
    Case DMRES_HIGH:
      uPrn.sPrintQuality = "hoch"
    Case DMRES_LOW:
      uPrn.sPrintQuality = "niedrig"
    Case DMRES_MEDIUM:
      uPrn.sPrintQuality = "mittel"
    Case Else:
      uPrn.sPrintQuality = _
          CStr(uPrn.lPrintQuality) & " dpi"
    End Select
    '// ---------------------------------------------------
    '// TrueType-Schriftart
    '// ---------------------------------------------------
    uPrn.lTrueTypeOption = uDevMode.dmTTOption
    Select Case uPrn.lTrueTypeOption
    Case DMTT_BITMAP:
      uPrn.sTrueTypeOption = _
          "TrueType Schriften als Grafik"
    Case DMTT_DOWNLOAD:
      uPrn.sTrueTypeOption = _
          "TrueType Schriften als 'Softfonts' laden"
    Case DMTT_SUBDEV:
      uPrn.sTrueTypeOption = _
          "Durch Geräteschriftart ersetzen"
    Case Else:
      uPrn.sTrueTypeOption = "nicht definiert"
    End Select
    '// ---------------------------------------------------
    '// Farbe (Farbmischung)
    '// ---------------------------------------------------
    uPrn.lColorOrMonochrome = uDevMode.dmColor
    Select Case uPrn.lColorOrMonochrome
    Case DMCOLOR_MONOCHROME:
      uPrn.sColorOrMonochrome = "Monochrom"
    Case DMCOLOR_COLOR:
      uPrn.sColorOrMonochrome = "Farbe"
    Case Else:
      uPrn.sColorOrMonochrome = "nicht definiert"
    End Select
    '// ---------------------------------------------------
    '// Skaliermodus
    '// ---------------------------------------------------
    uPrn.lScaleFactor = uDevMode.dmScale
    Select Case uPrn.lScaleFactor
    Case 0:
      uPrn.sScaleFactor = "keiner"
    Case Else:
      uPrn.sScaleFactor = CStr(uPrn.lScaleFactor)
    End Select
    '// ---------------------------------------------------
    '// Sortieren
    '// ---------------------------------------------------
    uPrn.lFields = uDevMode.dmFields
    If uPrn.lFields And DM_COLLATE Then
      Select Case uDevMode.dmCollate
      Case DMCOLLATE_FALSE:
        uPrn.sCollating = _
            "wird unterstützt (deaktiviert)"
      Case DMCOLLATE_TRUE:
        uPrn.sCollating = _
            "wird unterstützt (aktiviert)"
      End Select
    Else
      uPrn.sCollating = "nicht definiert"
    End If
    '// ---------------------------------------------------
    '// Duplex
    '// ---------------------------------------------------
    uPrn.lDuplex = uDevMode.dmDuplex
    If uDevMode.dmFields And DM_DUPLEX Then
      Select Case uPrn.lDuplex
      Case DMDUP_SIMPLEX:
        uPrn.sDuplex = _
            "wird unterstützt (deaktiviert)"
      Case DMDUP_VERTICAL:
        uPrn.sDuplex = _
            "wird unterstützt (vertikal)"
      Case DMDUP_HORIZONTAL:
        uPrn.sDuplex = _
            "wird unterstützt (horizontal)"
      Case Else:
        uPrn.sDuplex = _
            "undefinierter Wert (" & _
            CStr(uPrn.lDuplex) & ")"
      End Select
    Else
      uPrn.sDuplex = "nicht definiert"
    End If
    '// ---------------------------------------------------
    '// Auflösung
    '// ---------------------------------------------------
    uPrn.lYResolution = uDevMode.dmYResolution
    uPrn.sYResolution = CStr(uDevMode.dmYResolution) & _
        " dpi"
    '// ---------------------------------------------------
    '// Kopien
    '// ---------------------------------------------------
    uPrn.lCopies = uDevMode.dmCopies
    uPrn.sCopies = CStr(uPrn.lCopies)
 
    Call ClosePrinter(lPrinter)
    DefaultPrinterSettings = True
 
  End If
 
End Function
 
Public Function ByteToString(ByteArray() As Byte) As String
 
  Dim sTempValue  As String
  Dim lCount      As Long
  For lCount = 1 To CCHDEVICENAME
    sTempValue = sTempValue & Chr(ByteArray(lCount))
  Next lCount
  ByteToString = _
      VBA.Left(sTempValue, VBA.InStr(sTempValue, _
      vbNullChar) - 1)
 
End Function