VBA Drucker finden und in Variable speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Dim sDruckerToUse$, sStdDrucker$, sValue$, sKeyPath$ Dim oReg As Object, lCount&, arrPrinter, arrPrintList Sub DruckenNachAuswahl() '* hier einen Namensteil des zu benutzenden Druckers auswählen, der immer gleich bleibt sDruckerToUse = "Brother QL-800" Call DruckerAuswaehlen End Sub Sub DruckerAuswaehlen() On Error GoTo ende Const HKEY_current_user = &H80000001 sKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Devices" Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") oReg.EnumValues HKEY_current_user, sKeyPath, arrPrinter sStdDrucker = Application.ActivePrinter '* Standarddrucker festhalten '* gewünschten Drucker auswählen und drucken For lCount = 0 To UBound(arrPrinter) If InStr(1, arrPrinter(lCount), sDruckerToUse) > 0 Then oReg.GetStringValue HKEY_current_user, sKeyPath, arrPrinter(lCount), sValue Application.ActivePrinter = arrPrinter(lCount) & Replace(sValue, "winspool,", " auf ") ActiveSheet.PrintOut '* Drucken Exit For End If Next ende: Application.ActivePrinter = sStdDrucker '* Standarddrucker wieder aktivieren End Sub

Sub DruckerPortZuordnung() Dim strDrucker As String strDrucker = "Brother MFC-9142CDN Printer" strDrucker = strDrucker & " auf " & GetPrinterPort(strDrucker) On Error Resume Next Application.ActivePrinter = strDrucker If Err > 0 Then MsgBox "Drucker nicht gefunden" On Error GoTo 0 Debug.Print Application.ActivePrinter End Sub Function GetPrinterPort(strPrinterName As String) As String Dim objReg As Object Dim strRegVal As String Dim strValue As String Const HKEY_CURRENT_USER = &H80000001 Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") strRegVal = "Software\\Microsoft\\Windows NT\\CurrentVersion\\PrinterPorts\\" objReg.GetStringValue HKEY_CURRENT_USER, strRegVal, strPrinterName, strValue GetPrinterPort = Mid$(strValue, 10, 5) End Function

Danke Schon mal für die schnelle Rückmeldung.

Wenn ich jetzt aber das so ändere

von
Application.ActivePrinter = "Epson ET-2710 Series auf Ne05:" -- hier schmeisst er mir den Laufzeit error

auf

Application.ActivePrinter = "Epson ET-2710 Series"

dann bekomme ich eine Laufzeit error bei genau der Zeile.
dies wäre ein Teil der funktion:

If Worksheets("Tabelle1").Range("C6").Value = "Test CH" Then

Application.ActivePrinter = "Epson ET-2710 Series" --- ist der Drucker bei mir zuhause

Sheets(1).PrintOut

-------ab hier habe ich es zum testen zuhause auskommentiert-----

'Application.ActivePrinter = "Brother QL-800 auf Ne00:" -- ist ein Etikettendrucker der angesteuert werden soll
'
'
' With Sheets("etikett_ch")
' .PageSetup.PrintArea = "$A$1:$D$10"
' .PrintOut
' .PrintOut Copies:=1
' End With
'Application.ActivePrinter = "Brother MFC-9142CDN Printer auf NE05:" -- ist der Normale Drucker der angesteuert werden soll.
------ auskommentierung ende----

End If

nochmals vielen Dank.

Hier mal was aus der Mottenkiste. Kommst du damit zurecht? Ich habs heute nicht getestet muß aber mal funktionert haben.

Option Explicit





'Standarddrucker: Xerox WorkCentre 3220 (Kopie 1) auf Ne00:

'der Zieldrucker: TEC B-SA4T (203 dpi) auf Ne02:





Sub Drucken_mit_gewuenschtemDrucker()

   Dim sGewünschterDrucker$, iRow%

   

   sGewünschterDrucker = "TEC B-SA4T (203 dpi)"

   

   Call DruckerAuflisten   'Funktionsaufruf

   

   With Tab_Druckerliste  

      '* FarbDrucker auswählen

         For iRow = 3 To 25

            If InStr(1, .Cells(iRow, 1), sGewünschterDrucker) > 0 Then

               Application.ActivePrinter = .Cells(iRow, 1)

               Exit For

            End If

         Next iRow

         

      '* Drucken

         ActiveSheet.PrintOut '* evtl. anpassen!!!

      

      '* StandardDrucker zurück holen/einstellen

         For iRow = 3 To 25

            If InStr(1, .Cells(iRow, 1), "Xerox WorkCentre 3220 (Kopie 1)") > 0 Then

               Application.ActivePrinter = .Cells(iRow, 1)

               Exit For

            End If

         Next iRow

   End With

End Sub





Sub DruckerAuflisten()

   Dim oReg As Object, iCount%, sKeyPath$, sValue$, arrPrinter As Variant, arrPrintList, sBereich$

   

   Const HKEY_CURRENT_USER = &H80000001

   sKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

   

   Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

       oReg.EnumValues HKEY_CURRENT_USER, sKeyPath, arrPrinter

   

   With Tab_Druckerliste

      sBereich = "A3:A25"

      

      Application.EnableEvents = False

         .Range(sBereich).ClearContents

         arrPrintList = .Range(sBereich)

            For iCount = 0 To UBound(arrPrinter)

               oReg.GetStringValue HKEY_CURRENT_USER, sKeyPath, arrPrinter(iCount), sValue

               arrPrintList(iCount + 1, 1) = arrPrinter(iCount) & Replace(sValue, "winspool,", " auf ")

            Next

         .Range(sBereich).Value = arrPrintList

      Application.EnableEvents = True

   End With

End Sub

Sub Druckerzuordnung() For i = 1 To 9 On Error Resume Next Application.ActivePrinter = "Brother MFC-9142CDN Printer auf Ne05:" If Err = 0 Then Application.ActivePrinter = "Brother MFC-9142CDN Printer auf Ne0" & i & ":":Exit For Next i On Error GoTo 0 End Sub

Sub Druckerzuordnung() On Error Resume Next Application.ActivePrinter = "Brother MFC-9142CDN Printer auf Ne05:" ' im Fehlerfall versuchen den richtigen Port zu finden If Err > 0 Then For i = 1 To 9 Application.ActivePrinter = "Brother MFC-9142CDN Printer auf Ne0" & i & ":" If Err = 0 Then Err.Clear Exit For End If Next i End If If Err > 0 Then MsgBox "Drucker nicht gefunden" On Error GoTo 0 Debug.Print Application.ActivePrinter End Sub

Sub DruckerWahl() On Error Resume Next Application.ActivePrinter = "Brother MFC-9142CDN Printer auf Ne05:" 'Im Fehlerfall Druckerdialog aufrufen If Err > 0 Then Application.Dialogs(xlDialogPrinterSetup).Show Err.Clear On Error GoTo 0 Debug.Print Application.ActivePrinter End Sub

Sub Druckerzuordnung() On Error Resume Next Application.ActivePrinter = "Microsoft Print to PDF auf Ne05:" ' im Fehlerfall versuchen den richtigen Port zu finden If Err > 0 Then For i = 1 To 9 Err.Clear Application.ActivePrinter = "Microsoft Print to PDF auf Ne0" & i & ":" If Err = 0 Then Err.Clear Exit For End If Next i End If If Err > 0 Then MsgBox "Drucker nicht gefunden" On Error GoTo 0 Debug.Print Application.ActivePrinter End Sub

Sub Druckerzuordnung() Dim i For i = 1 To 9 On Error Resume Next Application.ActivePrinter = "Brother MFC-9142CDN Printer auf Ne0" & i & ":" Next i On Error GoTo 0 End Sub

Sub DruckerPortZuordnung() Dim strPrinter As String Dim strOnLocal As String Dim i As Long Dim v As Variant strPrinter = "Brother MFC-9142CDN Printer" v = Split(Application.ActivePrinter, " ") strOnLocal = Space(1) & v(UBound(v) - 1) & Space(1) For i = 1 To 9 On Error Resume Next Application.ActivePrinter = strPrinter & strOnLocal & "Ne0" & i & ":" If Err = 0 Then Exit For Next i If Err > 0 Then MsgBox "Drucker nicht gefunden" Debug.Print Application.ActivePrinter End Sub

Beliebteste Forumthreads (12 Monate)

VBA Drucker finden und in Variable speichern

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Drucker finden und in Variable speichern

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread