Autor: Peter Haserodt  --- Aus Excel VBA - Gruppe: Verschiedenes

Druckerauswahl auf der Userform - Drucken mit wählbarem Drucker

Autor: Peter Haserodt - Erstellt: --      - Letzte Revision: --
Druckerauswahl auf der Userform- Drucken mit wählbarem Drucker

(Beachten Sie, dass es für die Druckerauswahl auch den Dialog: Application.Dialogs(xlDialogPrinterSetup).Show gibt, wenn Sie die Druckerauswahl nicht auf der Userform selbst darstellen wollen.)

Es gibt Sitationen, in welchen man programmgesteuert drucken will, aber dem Anwender die Druckerauswahl überlassen will.

Ich möchte Ihnen hier ein rudimentäres Gerüst zeigen, welches Sie für Ihre Bedürfnisse anpassen/ausbauen können.

Nehmen Sie sich eine leere Arbeitsmappe und dazu ein Modul und eine Userform.
Hier kommt nun ersteinmal der Code(Beachten Sie die Hinweise zu den Steuerelementen):



' **************************************************************
'  Modul:  UserForm1  Typ = Userform
' **************************************************************

Option Explicit
' #################################################################
' Benötigte Steuerlemente auf der Userform:
' Commandbutton mit Namen CommandButton1
' Combobox mit Namen ComboBox1
' #################################################################


Private Sub CommandButton1_Click()
Dim sOldPrinter As String
sOldPrinter = Application.ActivePrinter ' Alten Drucker merken
On Error GoTo Fehler:
If ComboBox1.ListIndex = -1 Then
   MsgBox "Kein Printer gewählt", vbExclamation
   Exit Sub
End If

With ThisWorkbook.Worksheets(1) ' muss vorhanden sein
   .Range("a1") = "Was zum Drucken"
   .PageSetup.PrintArea = "$A$1:$B$4" ' Kleinen Druckbereich setzten zum Testen
   
   .PrintOut , , , , ComboBox1.Text ' auf den gewünschten Drucker drucken
   
Aufraeumen:
   Application.ActivePrinter = sOldPrinter ' Wieder zurücksetzen
   Exit Sub
Fehler:
   MsgBox Err.Description
   Resume Aufraeumen

End With

End Sub


Private Sub UserForm_Initialize()
Dim i As Long
ComboBox1.Style = fmStyleDropDownList
If GetPrinters(ComboBox1) = False Then
   MsgBox "Kein Drucker gefunden", vbExclamation
   Exit Sub
End If
For i = 0 To ComboBox1.ListCount - 1
   If ActivePrinter Like ComboBox1.List(i) & "*" Then ' Etwas gemurkst aber was solls
      ComboBox1.ListIndex = i
      Exit For
   End If
Next i
End Sub


' **************************************************************
'  Modul:  Modul1  Typ = Allgemeines Modul
' **************************************************************

Option Explicit
Option Private Module
    ' Frei angepasst von PH nach dem Beispiel von
    'KPD-Team
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net

Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" _
   (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" _
   (ByVal lpString As Long) As Long

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
   (ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
   pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Const PRINTER_ENUM_LOCAL = &H2
Private Type PRINTER_INFO_1
        flags As Long
        pDescription As String
        pName As String
        pComment As String
End Type


Public Function GetPrinters(DieCombo As MSForms.ComboBox) As Boolean
 Dim longbuffer() As Long  ' resizable array receives information from the function
    Dim numbytes As Long  ' size in bytes of longbuffer()
    Dim numneeded As Long  ' receives number of bytes necessary if longbuffer() is too small
    Dim numprinters As Long  ' receives number of printers found
    Dim c As Integer, retval As Long  ' counter variable & return value
    Dim sTemp As String
    DieCombo.Clear
 numbytes = 3076  ' should be sufficiently big, but it may not be
ReDim longbuffer(0 To numbytes / 4) As Long  ' resize array -- note how 1 Long = 4 bytes

retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer(0), _
   numbytes, numneeded, numprinters)
If retval = 0 Then  ' try enlarging longbuffer() to receive all necessary information
        numbytes = numneeded
        ReDim longbuffer(0 To numbytes / 4) As Long  ' make it large enough
        retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, _
         longbuffer(0), numbytes, numneeded, numprinters)
        If retval = 0 Then ' failed again!
            GetPrinters = False
            Exit Function
        End If
    End If
If numprinters <> 0 Then ReDim printinfo(0 To numprinters - 1) As PRINTER_INFO_1
GetPrinters = True
    For c = 0 To numprinters - 1  ' loop, putting each set of information into each element

sTemp = Space(lstrlen(longbuffer(4 * c + 2)))

      retval = lstrcpy(sTemp, longbuffer(4 * c + 2))

      DieCombo.AddItem sTemp

    Next c

End Function


Interner Tipp:
Eine Excel Schulung von einem Profi ist Gold wert!
Peter Haserodt bietet Ihnen das und noch viel mehr...
Mehr dazu unter: Schulung

Kurze Codeanalyse:

Den Code zur Druckerauflistung habe ich in ein allgemeines Modul ausgelagert.
Zum Finden der Drucker wird die API EnumPrinters eingesetzt. Schön ist es, dass man sich für die Handhabung dieser API keine (großen) Gedanken machen muss, da es im Netz viele Beispiele dazu gibt, bzw. vom API Guide ein umbaubares Beispiel, welches ich hier benutzt habe.

In unserer Funktion GetPrinters wird die Arbeit erledigt. Dieser wird die ComboBox unserer UserForm übergeben, die als Zielcontainer dient und hier gefüllt wird. (DieCombo.AddItem sTemp)

Gleichzeitig gibt die Function zurück ob sie überhaupt einen Printer gefunden hat.

Die Function wird im Beispiel vom Initialize aufgerufen.
Ein Problem war für mich, den ActivePrinter in der ComboBox eizustellen, da dieser eine ergänzende Zeichenfolge hat (blabla:LPT1 während der Name des Druckers nur blabla ist).

Also ein bisserl Getrickse und hoffen, dass nicht zwei gleiche Printer da rumlaufen. Sicherlich gibt es da noch eine bessere Lösung, überlasse ich Ihnen :-).

Unser CommandButton macht nichts anderes als mit dem gewählten Drucker was rauszudrucken.
Die PrintOut Methode sollte Ihnen bekannt sein und diese können Sie Ihren Bedürfnissen entsprechend anpassen.

Wichtig ist aber, den ActivePrinter wieder zurückzusetzen!


Weitere Artikel der Gruppe: Verschiedenes Aus Excel VBA
Nach oben