' **************************************************************
'  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