VBA Drucker finden und in Variable speichern

Jan · 2024-02-26T19:25:53+00:00

Hallo, ich bin aktuell grade am verzweifeln, ich habe das Problem das ich zwei unterschiedliche Drucker ansteuern muss. hier ist das Problem das die Drucker Ihre Adresse ab und zu ändern z.B. von "Ne00 auf Ne03". ich brauche hier eine Funktion die mir die Drucker sucht und dann die Richtige Andresse in einer Variablen Speichert auf die ich dann mit anderen Funktionen zugreifen kann. an dem PC arbeiten auch Personen die mit VBA so gar nichts am Hut haben, deswegen Ansteuerung über einen Button. Die Druckersuche wollte ich über einen Button anstoßen (am besten einmal am Morgen) und danach sollen die Drucker über die Variable angesteuert werden. ich hoffe das dies so möglich ist wie ich mir das vorstelle. schon mal vielen Dank im Voraus. Jan

Hallo Jan,

probiers mal damit:

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

Damit wird er den oben eingetragenen Drucker immer finden und ihm das jeweils aktuelle "Nexy" hinzufügen.

Servus

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

VBA Drucker finden und in Variable speichern

Forumthread: VBA Drucker finden und in Variable speichern

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

VBA Drucker finden und in Variable speichern

Forumthread: VBA Drucker finden und in Variable speichern

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread