VBA: Automatisch auf richtigem Drucker drucken

Private Sub Workbook_BeforePrint(Cancel As Boolean) 'Kontrolle, ob Urkunde gedruckt wird If InStr(LCase(ActiveSheet.Name), "urkunde") > 0 Then 'Urkunden-Drucker Application.ActivePrinter = "Urkunden-Drucker auf Ne06:" Else 'Standarddrucker Application.ActivePrinter = "Dokumenten-Drucker auf Ne04:" End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Martin,
das Makro könnte schon funktionieren, allerdings müssten die Druckernamen auf allen PCs identisch sein - insbesondere der Anschluss (Port) Ne06: und Ne04:.
Mit folgendem Konstrukt, kannst Du den Drucker ändern, ohne auf den Port achten zu müssen - dieser wird hier automatisch ermittelt :

Option Base 0
Const MAX_PRINTERS = 32
Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Dim strPrinterNames(MAX_PRINTERS) As String     'Hier erscheint der Druckername (z.B. "Adobe  _
PDF")
Dim strPrinterDrivers(MAX_PRINTERS) As String   'Hier erscheint der Treiber bzw. Spoolername
Dim strPrinterPorts(MAX_PRINTERS) As String     'Hier erscheint der Druckerpot (Ne01: etc.)
Dim intPrinterCount As Integer
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'Kontrolle, ob Urkunde gedruckt wird
If InStr(LCase(ActiveSheet.name), "urkunde") > 0 Then
'Urkunden-Drucker
DruckerAendern "Urkunden-Drucker"
Else 'Standarddrucker
DruckerAendern "Dokumenten-Drucker"
End If
End Sub
Sub DruckerAendern(strDrucker)
'Bitte nur dieses Makro starten !!
Dim r As Long
Dim Buffer As String
Dim i As Integer
Dim strOldPrinter As String
' Liste aller Drucker aus der Registry auslesen
Buffer = Space(8192)
r = GetProfileString("PrinterPorts", vbNullString, "", Buffer, Len(Buffer))
' Druckernamen und -ports parsen
GetPrinterNames Buffer
GetPrinterPorts
strOldPrinter = Application.ActivePrinter 'alten Standarddrucker sichern
For i = 1 To intPrinterCount
If strPrinterNames(i) = strDrucker Then
Application.ActivePrinter = strPrinterNames(i) & " auf " & strPrinterPorts(i)
End If
'MsgBox strPrinterNames(i) & " / " & strPrinterPorts(i) & " / " & strPrinterDrivers(i)
Next i
'MsgBox Application.ActivePrinter, , "Neuer Standarddrucker :"
Application.ActivePrinter = strOldPrinter 'alten Standarddrucker wieder herstellen
End Sub
'Diese Makros bitte NICHT manuell starten !
Private Sub GetPrinterNames(ByVal Buffer As String)
Dim i As Integer
Dim strName As String
intPrinterCount = 0
Do
i = InStr(Buffer, Chr(0))
If i > 0 Then
strName = Left(Buffer, i - 1)
If Len(Trim(strName)) > 0 Then
strPrinterNames(intPrinterCount) = Trim(strName)
intPrinterCount = intPrinterCount + 1
End If
Buffer = Mid(Buffer, i + 1)
Else
If Len(Trim(Buffer)) > 0 Then
strPrinterNames(intPrinterCount) = Trim(Buffer)
intPrinterCount = intPrinterCount + 1
End If
Buffer = ""
End If
Loop While (i > 0) And (intPrinterCount  0 Then
DriverName = Left(Buffer, iDriver - 1)
iPort = InStr(iDriver + 1, Buffer, ",")
If iPort > 0 Then
PrinterPort = Mid(Buffer, iDriver + 1, _
iPort - iDriver - 1)
End If
End If
End Sub

Ich hoffe, das klappt wie gewünscht.
Gruß, NoNet

Beliebteste Forumthreads (12 Monate)

VBA: Automatisch auf richtigem Drucker drucken

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread