Systemdrucker in Variable speichern

Hallo zusammen,
nach Tagelanger suche, hoffe ich, dass mir jemand helfen kann.
Ich habe folgende Problematik:
Ich habe mir ein Makro zusammengebastelt, welches Hyperlinks (oder Text) öffnet und Druckt (PDF). Das funktioniert auch wunderbar. Allerdings funktioniert das ganze über ShellExecute. Deshalb funktiert das nur auf dem im System eingestellten Standarddrucker und kann nicht mit Application.ActivePrinter beeinflusst werden.
Durch meine Recherche bin ich auf die Funktionen von DB-Wiki gestossen, welche den Systemdrucker anzeigen und ändern können:

Private Declare Function GetDefaultPrinter Lib "winspool.drv" Alias "GetDefaultPrinterA" ( _
ByVal pszBuffer As String, _
ByRef pcchBuffer As Long _
) As Long
Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" ( _
ByVal pszPrinter As String _
) As Long


Public Function Standarddruckername()
'Windows-Standarddruckernamen auslesen
'Quelle: www.dbwiki.net oder www.dbwiki.de
Dim strName As String
Dim lngZeichen As Long
Dim lngret As Long
lngret = GetDefaultPrinter(strName, lngZeichen)
strName = String(lngZeichen, 0)
lngret = GetDefaultPrinter(strName, lngZeichen)
Standarddruckername = Left(strName, lngZeichen - 1)
End Function


Public Function StandarddruckerÄndern(ByVal Druckername As String) As Boolean
'Windows-Standarddrucker ändern
'Quelle: www.dbwiki.net oder www.dbwiki.de
StandarddruckerÄndern = CBool(SetDefaultPrinter(Druckername & vbNullChar))
End Function

Da das Makro von unterschiedlichen Benutzern ausgeführt werden soll, besteht jetzt mein Problem, das ich den zuvor aktiven Standarddrucker speichern möchte, um ihn nach dem Druck wieder zu Aktivieren. Der Druck vom Makro soll in dem Fall über PDFCreator laufen. Ich kann den Standarddrucker ohne Probleme auf den PDFCreator ändern, allerdings müsste man dann manuell seinen alten Drucker wieder setzen.
Wie kann ich jetzt die Funktion Standarddruckername so "missbrauchen", dass ich den alten Drucker wieder verwenden kann, wenn das Marko durchgelaufen ist?
Anbei noch das Makro, welches mir die PDF-Dateien aufruft und ausdruckt. Vielleicht gibt es da noch was einfacheres.

Sub ZeichnungenDrucken()
Dim objShell As Object
Dim strTMP() As String
Dim LetzteZeile As Long
Dim c As Variant
Const Zeile1 = 2    'ab dieser Zeile beginnen
Const Spalte = "D"  'In dieser Spalte Arbeiten
LetzteZeile = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 'letzte Zeile der Spalte  _
definieren
On Error GoTo Fin 'Bei fehlern zum Abschnitt "Fin" springen
Set objShell = CreateObject("Shell.Application")
For Each c In Range(Cells(Zeile1, Spalte), Cells(LetzteZeile, Spalte)) 'Anzahl der Zellen  _
feststellen
If c.Formula Like "=HYPERLINK(*" Then 'wenn in der Zelle ein Hyperlink ist...
strTMP = Split(c.Formula, """")
objShell.ShellExecute strTMP(1), "", "", "Print", 1 '...dann Drucken
ElseIf c.Hyperlinks.Count > 0 Then
objShell.ShellExecute c.Hyperlinks.Item(1).Address, "", "", "Print", 1 'Wenn kein  _
Hyperlink mehr da ist...
ElseIf Dir(c.Text)  "" Then
objShell.ShellExecute c.Text, "", "", "Print", 1 '...dann nach Hyperlinks als Text  _
suchen.
End If
Application.Wait Now + TimeSerial(0, 0, 2) 'Wartezeit nach jeder Zeichnung
Next
Fin: 'Fehlermeldung erzeugen
Set objShell = Nothing  'Objekt auflösen
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description  'Wenn Fehler vorhanden, Fehlercode anzeigen
End Sub

Vielen Danke im voraus!
Nurbel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Faxen() Dim savPrinter As String savPrinter = ActivePrinter ' aktuellen Drucker auslesen ActivePrinter = "WinFax Pro 9.0" ' anderen Drucker einstellen ActiveSheet.PrintOut ActivePrinter = savPrinter ' Drucker wieder zurückstellen end Sub

Hallo Nurbel,
ich habe dir mal ein Beispiel gemacht. Dort wird erst der Standarddrucker ermittelt, stimmt dieser mit dem gewünschten (DOCUMENT_PRINTER) nicht überein, dann wird der Standarddrucker neu gesetzt, dann gedruckt und am Ende wird wieder der Standarddrucker gesetzt.

Option Explicit

Private Declare PtrSafe Function ShellExecuteA Lib "shell32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As LongPtr
Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliseconds As Long)

Private Const SW_HIDE As Long = 0&

Public Sub ZeichnungenDrucken()

    Const DOCUMENT_PRINTER As String = "Send To OneNote 2013" 'anpassen !!!

    Dim strDefaultPrinter As String
    Dim objWMI As Object, objItem As Object

    On Error GoTo err_exit

    Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer")
    For Each objItem In objWMI
        If objItem.Default Then
            strDefaultPrinter = objItem.Name
            Exit For
        End If
    Next

    If DOCUMENT_PRINTER <> strDefaultPrinter Then
        Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery( _
            "Select * from Win32_Printer")
        For Each objItem In objWMI
            If DOCUMENT_PRINTER = objItem.Name Then
                Call objItem.SetDefaultPrinter
                Exit For
            End If
        Next
    End If

    Call ShellExecuteA(Application.hwnd, "print", "G:\Eigene Dateien\Eigene Dokumente\Mathematikunterricht.txt", _
        vbNullString, vbNullString, SW_HIDE)

    Call Sleep(2000&)

    If DOCUMENT_PRINTER <> strDefaultPrinter Then
        Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery( _
            "Select * from Win32_Printer")
        For Each objItem In objWMI
            If objItem.Name = strDefaultPrinter Then
                Call objItem.SetDefaultPrinter
                Exit For
            End If
        Next
    End If

    Set objWMI = Nothing
    Set objItem = Nothing

    Exit Sub

    err_exit:
    Call MsgBox("Fehler: " & Err.Number & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlr beim Drucken")
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Systemdrucker in Variable speichern

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread