Farbig/SW Druck per Button

Gunter · 2016-11-10T09:31:34+00:00

Hallo Zusammen Ein Tabellenblatt soll je nach Bedarf farbig oder s/w ausgedruckt werden. Um das ganze für den User einfacher zu machen, wäre es schön das per VBA mit zwei Buttons auf dem Tabellenblatt zu lösen. Per Makrorecorder habe ich folgendes erhalten: Sub DruckSW() ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False End Sub Damit funktioniert der Druck entsprechend der voreingestellten Druckereinstellungen. Leider funktioniert es mit dem Makrorecorder nicht die Druckerumstellung von s/w auf Farbe und umgekehrt aufzuzeichnen. Gibt es eine Möglichkeit das per VBA-Option zu realisieren? Für zweckdienliche Hinweise herzlichen Dank. Gruss Gunter

Hallo Gunter,
ich hatte ein ähnliches Problem; dazu musste ich die IP-Anschrift des Farbdruckers in den Code einbinden.
Zum Auslesen welcher Drucker welche IP-Anschrift oder welchen Namen hat, ist folgender Code sehr gut (Ergebnis wird im Fenster Direktbereich angezeigt):

Sub ListAllPrinters()
Dim WshNetwork As Object, oPrinters As Object, i%
Set WshNetwork = CreateObject("WScript.Network")
Set oPrinters = WshNetwork.EnumPrinterConnections
For i = 0 To oPrinters.Count - 1 Step 2
Debug.Print oPrinters.Item(i + 1) & " an " & oPrinters.Item(i)
Next
Set WshNetwork = Nothing
End Sub

Für den Ausdruck auf den Farbdrucker benutze ich dann folgenden Code (hier wurde mir in einem anderen Forum sehr gut geholfen):

Public Function GetPrinterName(sIPAdress As String) As String
Const HKEY_current_user = &H80000001
Dim oReg As Object, i As Long
Dim strKeyPath As String, strValue As String
Dim arrPrinter As Variant
Dim oWSN As Object
Dim oPrinter As Object
Dim sPrinterName As String
Dim sResult As String
Set oWSN = CreateObject("WScript.Network")
Set oPrinter = oWSN.EnumPrinterConnections
For i = 0 To oPrinter.Count - 1 Step 2
If oPrinter.Item(i) = sIPAdress Then
sPrinterName = oPrinter.Item(i + 1)
Exit For
End If
Next
If sPrinterName = "" Then Exit Function
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv" _
)
strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
oReg.EnumValues HKEY_current_user, strKeyPath, arrPrinter
For i = 0 To UBound(arrPrinter)
If arrPrinter(i) = sPrinterName Then
oReg.GetStringValue HKEY_current_user, strKeyPath, arrPrinter(i), sResult
sResult = arrPrinter(i) & Replace(sResult, "winspool,", " auf ")
Exit For
End If
Next
GetPrinterName = sResult
Set oReg = Nothing
End Function
Sub Farbdruck()
Dim sOldPrinter As String
Dim sNewPrinter As String
sOldPrinter = Application.ActivePrinter
sNewPrinter = GetPrinterName("5.4.5.194")
If Not sNewPrinter = "" Then
Application.ActivePrinter = sNewPrinter
'Hier wird dann entsprechend gedruckt
Worksheets("Testseite").PrintOut
'Zurückstellen auf Standarddrucker
Application.ActivePrinter = sOldPrinter
Else
MsgBox ("Achtung! Dieser Drucker existiert nicht!")
End If
Sheets("Daten").Select
End Sub

Vielleicht kannst du damit was anfangen.
Gruß
Michael

Hallo Michael
Ich habe hier:
https://dbwiki.net/wiki/VBA_Tipp:_Standarddrucker_auslesen_und_%C3%A4ndern
diese Funktionen
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: http://www.dbwiki.net/
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: http://www.dbwiki.net/
StandarddruckerÄndern = CBool(SetDefaultPrinter(Druckername & vbNullChar))
End Function

gefunden, mit denen das Problem zu lösen sein sollte. Leider sind meine VBA Kenntnisse so eingerostet, dass ich nicht weiss, wie das ganze einzubinden ist. Daher wäre ich froh du könntest mir damit helfen.
Gruss
Gunter

Forumthread: Farbig/SW Druck per Button

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Farbig oder Schwarz-Weiß Drucken in Excel mit VBA

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)