Tipp 0067 Papierfächer des aktiven Druckers auslesen
Autor/Einsender:
Datum:
  Angie
27.05.2001
Entwicklungsumgebung:   Word 97
Mit der FirstPageTray-Eigenschaft ist es in Word möglich, das Fach der Papierzufuhr für die erste Seite eines Dokuments oder Abschnitts festzulegen bzw. zurückzugeben, und mit der OtherPagesTray-Eigenschaft das Fach für alle weiteren Seiten.
In Word stehen dafür die WdPaperTray-Konstanten wie z. B. wdPrinterManualFeed, wdPrinterUpperBin und wdPrinterLowerBin zur Verfügung. Es stellt sich hier aber immer wieder die Frage, welche Konstante gilt für welches Papierfach des gerade aktiven Druckers.
Auch in VBA ist es möglich, mit der API-Funktion DeviceCapabilities die Konstanten der Papierfächer des aktiven Druckers als auch die Namen der Fächer zu ermitteln. In diesem Beispiel wird aufgezeigt, wie die so ermittelten Konstanten zur Festlegung der Papierzufuhr benutzt werden können.
 
Option Explicit

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

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

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
    Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
    ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
    ByVal dev As Long) As Long

Const DC_BINS = 6
Const DC_BINNAMES = 12

Dim fachErsteSeite As Long
Dim fachFolgeSeite As Long

Private Sub UserForm_Initialize()
  Dim sDeviceName As String
  Dim sDevicePort As String
  Dim hPrinter As Long
  Dim bins As Long
  Dim binList As String
  Dim binNum() As Integer
  Dim binString As String
  Dim x As Integer
  Dim strListe() As String

  DruckerNameErmitteln sDeviceName, sDevicePort

  If OpenPrinter(sDeviceName, hPrinter, 0) <> 0 Then

    Label1.Caption = "   " & ActivePrinter
    ListBox1.Clear
    ListBox1.ColumnCount = 2
    ListBox2.Clear
    ListBox2.ColumnCount = 2

    bins = DeviceCapabilities(sDeviceName, sDevicePort, _
            DC_BINS, ByVal vbNullString, 0)

    ReDim binNum(1 To bins)

    bins = DeviceCapabilities(sDeviceName, sDevicePort, _
            DC_BINS, binNum(1), 0)
    binList = String$(24 * bins, 0)
    bins = DeviceCapabilities(sDeviceName, sDevicePort, _
            DC_BINNAMES, ByVal binList, 0)

    ReDim strListe(1 To bins, 2)

    For x = 1 To bins
      binString = Mid(binList, 24 * (x - 1) + 1, 24)
      binString = Left(binString, InStr(1, binString, Chr(0)) - 1)

      strListe(x, 0) = binString
      strListe(x, 1) = (binNum(x))
    Next x

    ClosePrinter (hPrinter)

    ListBox1.List() = strListe
    ListBox2.List() = strListe

    Call PapierzufuhrErmitteln

  Else
    Label1.Caption = ActivePrinter & " nicht ansprechbar!"
    ListBox1.Clear
    ListBox2.Clear
    cmdUebernehmen.Enabled = False

  End If
End Sub

Private Sub DruckerNameErmitteln(druckerName As String, _
    druckerPort As String)

  Dim sString As String
  Const suchText As String = " on "

  sString = ActivePrinter
  druckerName = Left(sString, InStr(1, sString, suchText) - 1)
  druckerPort = Right(sString, Len(sString) - Len(druckerName) - _
      Len(suchText))

End Sub

Private Sub PapierzufuhrErmitteln()
  Dim x As Integer

  fachErsteSeite = ActiveDocument.PageSetup.FirstPageTray
  If fachErsteSeite = 0 Then
      ListBox1.ListIndex = 0
  Else
    For x = 0 To ListBox1.ListCount - 1
      If ListBox1.List(x, 1) = fachErsteSeite Then
        ListBox1.ListIndex = x
        Exit For
      End If
    Next x
  End If

  fachFolgeSeite = ActiveDocument.PageSetup.OtherPagesTray
  If fachFolgeSeite = 0 Then
      ListBox2.ListIndex = 0
  Else
    For x = 0 To ListBox1.ListCount - 1
      If ListBox2.List(x, 1) = fachFolgeSeite Then
        ListBox2.ListIndex = x
        Exit For
      End If
    Next x
  End If
End Sub

Private Sub ListBox1_Click()
  If ListBox1.ListCount >= 1 Then
     fachErsteSeite = ListBox1.List(ListBox1.ListIndex, 1)
  End If
End Sub

Private Sub ListBox2_Click()
  If ListBox2.ListCount >= 1 Then
     fachFolgeSeite = ListBox2.List(ListBox2.ListIndex, 1)
  End If
End Sub

Private Sub cmdUebernehmen_Click()
  ActiveDocument.PageSetup.FirstPageTray = fachErsteSeite
  ActiveDocument.PageSetup.OtherPagesTray = fachFolgeSeite
End Sub
 
Hinweis
Der Quellcode im Download-Beispiel ist kommentiert, hier wurde jedoch aus Gründen der Übersichtlichkeit darauf verzichtet.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Word-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (17,6 kB) Downloads bisher: [ 3256 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 25. Juli 2011