VBA: Drucker wechseln
04.09.2024 10:14:48
David
ich habe versucht, "gemeinsam" mit ChatGPT ;) ein Makro zu erstellen, welches das aktive Blatt ausdruckt, vorher aber die Möglichkeit bietet, den Drucker über eine Userform auszuwählen (ohne den System-Dialog zu verwenden). Es ist immer wieder daran gescheitert, dass der Druck-Befehl die Übergabe des richtigen Druckers entweder mit Fehler quittiert oder einfach den Standard-Drucker verwendet hat.
Um das einzugrenzen, habe ich einen Testcode erstellt (erstellen lassen), der einfach alle Drucker nacheinander durchgehen soll (mit Ausnahmen):
Private Sub Test_Click()
Dim objWMI As Object
Dim printer As Object
Dim i As Integer
Dim response As VbMsgBoxResult
Dim formattedPrinterName As String
Dim portName As String
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Printer")
i = 1
For Each printer In objWMI
' Prüfen, ob der Druckername "XPS" oder "OneNote" enthält oder ob der Port "Portprompt" ist
If InStr(1, printer.Name, "XPS", vbTextCompare) = 0 And _
InStr(1, printer.Name, "OneNote", vbTextCompare) = 0 And _
InStr(1, printer.portName, "Portprompt", vbTextCompare) = 0 Then
' Druckername und Port korrekt formatieren
formattedPrinterName = printer.Name
portName = printer.portName
' Vor dem Setzen den Druckernamen und Port anzeigen
'MsgBox "Drucker: " & formattedPrinterName & vbCrLf & "Port: " & portName
response = MsgBox("Drucker " & i & ":" & vbCrLf & _
" Name: " & formattedPrinterName & " auf " & portName & vbCrLf & _
" Status: " & printer.PrinterStatus & vbCrLf & _
" Standarddrucker: " & printer.Default, _
vbOKCancel, "Druckerinformationen")
If response = vbCancel Then
Exit For
End If
On Error GoTo HandleError ' Fehlerbehandlung aktivieren
' Versuche, den aktiven Drucker zu setzen
Application.ActivePrinter = formattedPrinterName & " auf " & portName
' Drucke das aktive Blatt
ActiveSheet.PrintOut
i = i + 1
End If
Next printer
Exit Sub ' Ende des Makros, wenn kein Fehler auftritt
HandleError:
MsgBox "Fehler beim Setzen des Druckers: " & formattedPrinterName & " auf " & portName & vbCrLf & "Fehler: " & Err.Description
Resume Next ' Fortsetzen mit dem nächsten Drucker
End Sub
Obwohl hier der Druckername inklusive Port anscheinend korrekt übergeben wird (der String sieht zumindest optisch genauso aus), kommt ein Fehler "Die Methode 'ActivePrinter' für das Objekt '_Application' ist fehlgeschlagen"
ChatGPT kommt hier anscheinend an seine Grenzen, die Vorschläge drehen sich im Kreis.
Meine Vermutung ist, dass der Druckername mit Port vielleicht irgendwie anders formatiert werden muss. Kann hier jemand der VBA-Experten sagen, wo das Problem ist und ob meine Vorgehensweise überhaupt richtig ist?
Danke und Gruß
David
Anzeige