Office: (Office 2013) Druckereigenschaften per VBA einstellen

stefan1975 · 12. August 2014

Hallo haklesoft,

dass wir eine Wordlösung suchen, war mir bewusst. Ich wollte die Excellösung nachvollziehen und für Word anpassen - das Word den temporären Druckerwechsel nicht braucht, war mir nicht bekannt.

Deine Lösung druckt nach dem Aufruf von "PrintDuplexBooklet" einwandfrei auf meinem Standartdrucker. Ich werde als nächstes den Druckerwechsel und die Umstellung von S/W auf Farbdruck versuchen zu implementieren.

Wenn ich eine Lösung dazu habe, melde ich mich wieder.

Bis dahin schon mal vielen Dank für die Anregungen.

Viele Grüße

Stefan

haklesoft · 28. Januar 2021

von stefan1975

als nächstes den Druckerwechsel und die Umstellung von S/W auf Farbdruck versuchen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Druckerwechsel entfällt und Color-Umschaltung analog zur Duplex-Umschaltung: Code:

Sub PrintInColor()
Dim iColor As Long
'Debug.Print "Color vor", GetColorMode
iColor = GetColorMode 'save the current setting
SetColorMode 2 '1 = schwarz
'Debug.Print "Color während", GetColorMode
ActiveDocument.PrintOut Background:=False
SetColorMode iColor 'restore the original setting
'Debug.Print "Color nach", GetColorMode
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

stefan1975 · 12. August 2014

Wow,

ich kam nicht mal dazu mich an das Problem dranzusetzen, da hattest du schon eine Lösung parat.

Die Ausdruckmakros (Duplex + Color) laufen beide durch und drucken meine Testseite in s/w aus. Das Colormakro übergibt die gewünschte Einstellung (FARBdruck) nicht an den Drucker, da dieser nicht erreicht werden kann. Die Funktion wird in der Zeile Code:

iRet = OpenPrinter(sPrinterName, hPrinter, pd)
If (iRet = 0) Or (hPrinter = 0) Then
'Can't access current printer. Bail out doing nothing
Exit Function
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

verlassen.

Die Werte von GetColorMode (vor, während und nach) sind bei mir übrigens alle "0".

Viele Grüße

Stefan

haklesoft · 12. August 2014

Das ist ja komisch. Der von Dir gezeigte Codeblock wird sowohl beim Auslesen als auch beim Einschreiben von Duplex oder Color durchlaufen. Warum dann der Codeblock nur bei Color nicht funktioniert, ist nicht ersichtlich. Was steht denn in sPrinterName und in hPrinter unmittelbar vor Exit Function?

Obwohl ich nur einen Schwarzdrucker habe, meldet mir der den Color-Status 1 = schwarz und nach Umstellung 2 = Farbe; - obwohl er die gar nicht drucken kann.

Es gibt auch Druckertreiber, die keinen Farb-Status kennen und darin auch nicht gesetzt werden können.

stefan1975 · 12. August 2014

Hallo,

sPrinterName="\\Server\Druckername"
hPrinter="0"

Ich habe mehrere Colorlaserdrucker installiert und habe die Makros mit allen getestet. Nachdem ich einen Drucker als Standartdrucker auswählte, wurde sein Pfad als sPrinterName angegeben. hPrinter war immer "0".

Wo bekommt hPrinter eigentlich seinen Wert her? In denProzedur "GetPrinterProperty" und "SetPrinterProperty" wird hPrinter als Long definiert, aber soweit ich erkennen konnte, wird hPrinter danach kein neuer Wert zugewiesen - er bleibt also bis zur Abbruchbedingung "0" und erfüllt diese somit.

iRet ist übrigens auch immer "0", würde die Abbruchbedingung also ebenfalls erfüllen.

Wie kann ich herausbekommen, ob der Druckertreiber einen Farbstatus kennt? Wenn ich die Druckeinstellungen unter Start-Geräte und Drucker-Druckeinstellungen öffne, gibt es dort die Farbwahlmöglichkeit.

Vielen Dank für die Hilfe bisher.

Stefan

haklesoft · 28. Januar 2021

von stefan1975

Wo bekommt hPrinter eigentlich seinen Wert her?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das macht die API-Funktion OpenPrinter. Die schreibt in den übergebenen Puffer.

Bei mir klappt das mit meinem lokalen Drucker problemlos. Beim Netzwerkdrucker steigt er mir auch aus. Übrigens muss man nicht nur " on " im Druckernamen wegfiltern, sondern auch die deutsche Variante " auf ".

Printerstati kann man mit der API DeviceCapabilities ermitteln.

haklesoft · 12. August 2014

An den Routinen habe ich ein wenig geschraubt. Es wird nun der Standarddrucker lokal und mit einem UNC-Pfad erkannt.

Außerdem kann die Routine PrintExtend sowohl Duplex als auch Color schalten und ggf. nur die Schalterstellungen mit DebugPrint ausgeben. Code:

'Code als Basis übernommen aus dem Artikel
'Controlling the Printer from Word VBA
'by Jonathan West, MVP

'Das Modul enthält Routinen, mit denen das aktive Dokument
'im Duplex- und/oder Colormodus ausgedruckt werden kann
'sofern der Standard-Drucker über diese Fähigkeiten verfügt.

'Anpassungen vorgenommen in GetPrinterProperty und SetPrinterProperty
'speziell beim Printernamen und beim Zugriffsmodus

'Nicht benötigte Declares entfernt
'Alle Quality-Optionen entfernt
'Auflistung eDuplexArt und eColorArt vorgehängt

'Aufruf über PrintDuplexBooklet, PrintInColor oder PrintExtend
'#############################################################
Option Explicit

Enum eDuplexArt
Einfach = 1
Horizontal = 2
Vertikal = 3
End Enum

Enum eColorArt
Black = 1
Color = 2
End Enum

Private Type PRINTER_DEFAULTS
pDatatype As String 'Long
pDevMode As Long
DesiredAccess As Long
End Type

Private Type PRINTER_INFO_2
pServerName As Long
pPrinterName As Long
pShareName As Long
pPortName As Long
pDriverName As Long
pComment As Long
pLocation As Long
pDevMode As Long ' Pointer to DEVMODE
pSepFile As Long
pPrintProcessor As Long
pDatatype As Long
pParameters As Long
pSecurityDescriptor As Long ' Pointer to SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type

Private Type DEVMODE
dmDeviceName As String * 32
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long
End Type

Private Const DM_COLOR = &H800
Private Const DM_DUPLEX = &H1000

Private Const DM_IN_BUFFER = 8
Private Const DM_OUT_BUFFER = 2

Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_NORMAL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_USE)
Private Const PRINTER_ALL_ACCESS = _
(STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or _
PRINTER_ACCESS_USE)

Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Private Declare Function DocumentProperties Lib "winspool.drv" _
Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
ByVal hPrinter As Long, ByVal pDeviceName As String, _
ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _
ByVal fMode As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias _
"GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Byte, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias _
"SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Byte, ByVal Command As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal cbLength As Long)

Public Sub SetColorMode(iColorMode As Long)
SetPrinterProperty DM_COLOR, iColorMode
End Sub

Public Function GetColorMode() As Long
GetColorMode = GetPrinterProperty(DM_COLOR)
End Function

Public Sub setDuplexMode(iDuplex As Long)
SetPrinterProperty DM_DUPLEX, iDuplex
End Sub

Public Function GetDuplexMode() As Long
GetDuplexMode = GetPrinterProperty(DM_DUPLEX)
End Function

Private Function SetPrinterProperty(ByVal iPropertyType As Long, _
ByVal iPropertyValue As Long) As Boolean

'Code adapted from Microsoft KB article Q230743

Dim hPrinter As Long 'handle for the current printer
Dim PD As PRINTER_DEFAULTS
Dim pinfo As PRINTER_INFO_2
Dim dm As DEVMODE
Dim sPrinterName As String

Dim yDevModeData() As Byte 'Byte array to hold contents
'of DEVMODE structure
Dim yPInfoMemory() As Byte 'Byte array to hold contents
'of PRINTER_INFO_2 structure
Dim iBytesNeeded As Long
Dim iRet As Long
Dim iJunk As Long
Dim iCount As Long

On Error GoTo cleanup

'Get the name of the current printer
If InStr(ActivePrinter, " on ") > 0 Then
'sPrinterName = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))
sPrinterName = Split(ActivePrinter, " on ")(0)
ElseIf InStr(ActivePrinter, " auf ") Then
sPrinterName = Split(ActivePrinter, " auf ")(0)
Else
sPrinterName = ActivePrinter
End If

'PD.pDatatype = vbNullString
'PD.pDevMode = 0
PD.DesiredAccess = PRINTER_ACCESS_USE 'PRINTER_NORMAL_ACCESS

iRet = OpenPrinter(sPrinterName, hPrinter, PD)
If (iRet = 0) Or (hPrinter = 0) Then
'Can't access current printer. Bail out doing nothing
Exit Function
End If

'Get the size of the DEVMODE structure to be loaded
iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (iRet < 0) Then
'Can't access printer properties.
GoTo cleanup
End If

'Make sure the byte array is large enough
'Some printer drivers lie about the size of the DEVMODE structure they
'return, so an extra 100 bytes is provided just in case!
ReDim yDevModeData(0 To iRet + 100) As Byte

'Load the byte array
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (iRet < 0) Then
GoTo cleanup
End If

'Copy the byte array into a structure so it can be manipulated
Call CopyMemory(dm, yDevModeData(0), Len(dm))

If dm.dmFields And iPropertyType = 0 Then
'Wanted property not available. Bail out.
GoTo cleanup
End If

'Set the property to the appropriate value
Select Case iPropertyType
Case DM_COLOR
dm.dmColor = iPropertyValue
Case DM_DUPLEX
dm.dmDuplex = iPropertyValue
End Select

'Load the structure back into the byte array
Call CopyMemory(yDevModeData(0), dm, Len(dm))

'Tell the printer about the new property
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
DM_IN_BUFFER Or DM_OUT_BUFFER)

If (iRet < 0) Then
GoTo cleanup
End If

'The code above *ought* to be sufficient to set the property
'correctly. Unfortunately some brands of Postscript printer don't
'seem to respond correctly. The following code is used to make
'sure they also respond correctly.
Call GetPrinter(hPrinter, 2, 0, 0, iBytesNeeded)
If (iBytesNeeded = 0) Then
'Couldn't access shared printer settings
GoTo cleanup
End If

'Set byte array large enough for PRINTER_INFO_2 structure
ReDim yPInfoMemory(0 To iBytesNeeded + 100) As Byte

'Load the PRINTER_INFO_2 structure into byte array
iRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), iBytesNeeded, iJunk)
If (iRet = 0) Then
'Couldn't access shared printer settings
GoTo cleanup
End If

'Copy byte array into the structured type
Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))

'Load the DEVMODE structure with byte array containing
'the new property value
pinfo.pDevMode = VarPtr(yDevModeData(0))

'Set security descriptor to null
pinfo.pSecurityDescriptor = 0

'Copy the PRINTER_INFO_2 structure back into byte array
Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

'Send the new details to the printer
iRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)

'Indicate whether it all worked or not!
SetPrinterProperty = CBool(iRet)

cleanup:
'Release the printer handle
If (hPrinter 0) Then Call ClosePrinter(hPrinter)

'Flush the message queue. If you don't do this,
'you can get page fault errors when you try to
'print a document immediately after setting a printer property.
For iCount = 1 To 20
DoEvents
Next iCount
End Function

Private Function GetPrinterProperty(ByVal iPropertyType As Long) As Long

'Code adapted from Microsoft KB article Q230743

Dim hPrinter As Long
Dim PD As PRINTER_DEFAULTS
Dim dm As DEVMODE
Dim sPrinterName As String

Dim yDevModeData() As Byte
Dim iRet As Long

On Error GoTo cleanup

'Get the name of the current printer
If InStr(ActivePrinter, " on ") > 0 Then
'sPrinterName = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))
sPrinterName = Split(ActivePrinter, " on ")(0)
ElseIf InStr(ActivePrinter, " auf ") Then
sPrinterName = Split(ActivePrinter, " auf ")(0)
Else
sPrinterName = ActivePrinter
End If

'PD.pDatatype = vbNullString
'PD.pDevMode = 0
PD.DesiredAccess = PRINTER_ACCESS_USE 'PRINTER_NORMAL_ACCESS

'Get the printer handle
iRet = OpenPrinter(sPrinterName, hPrinter, PD)
If (iRet = 0) Or (hPrinter = 0) Then
'Couldn't access the printer
Exit Function
End If

'Find out how many bytes needed for the printer properties
iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (iRet < 0) Then
'Couldn't access printer properties
GoTo cleanup
End If

'Make sure the byte array is large enough, including the
'100 bytes extra in case the printer driver is lying.
ReDim yDevModeData(0 To iRet + 100) As Byte

'Load the printer properties into the byte array
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (iRet < 0) Then
'Couldn't access printer properties
GoTo cleanup
End If

'Copy the byte array to the DEVMODE structure
Call CopyMemory(dm, yDevModeData(0), Len(dm))

If Not dm.dmFields And iPropertyType = 0 Then
'Requested property not available on this printer.
GoTo cleanup
End If

'Get the value of the requested property
Select Case iPropertyType
Case DM_COLOR
GetPrinterProperty = dm.dmColor
Case DM_DUPLEX
GetPrinterProperty = dm.dmDuplex
End Select

cleanup:
'Release the printer handle
If (hPrinter 0) Then Call ClosePrinter(hPrinter)

End Function

'Druckt das aktuelle Dokument im horizontalen Duplexmodus aus
Sub PrintDuplexBooklet()

Dim iDuplex As Long

'Debug.Print "Duplex vor", GetDuplexMode
iDuplex = GetDuplexMode 'save the current setting

setDuplexMode 2 '3 = set for vertical binding
'Debug.Print "Duplex Job", GetDuplexMode

ActiveDocument.PrintOut Background:=False

setDuplexMode iDuplex 'restore the original setting
'Debug.Print "Duplex nach", GetDuplexMode

End Sub

'Druckt das aktuelle Dokument im Farbmodus aus
Sub PrintInColor()
Dim iColor As Long

'Debug.Print "Color vor", GetColorMode
iColor = GetColorMode 'save the current setting

SetColorMode 2 '1 = schwarz
'Debug.Print "Color Job", GetColorMode

ActiveDocument.PrintOut Background:=False

SetColorMode iColor 'restore the original setting
'Debug.Print "Color nach", GetColorMode

End Sub

'Druckt das aktuelle Dokument aus und schaltet dazu ggf.
'vorab einen Duplexmodus und/oder Colordruck ein/aus
'Außerdem können Hintergrunddruck und reine Debug-Ausgabe
'ebenfalls optional eingestellt werden
'Als Default gelten kein Duplex, keine Farbe,
'kein Hintergrunddruck, kein DebugPrint
Sub PrintExtend(Optional iDuplexArt As eDuplexArt = Einfach, _
Optional iColorArt As eColorArt = Black, _
Optional bBackground As Boolean = False, _
Optional bDebug As Boolean = False)

Dim iOldDuplex As eDuplexArt, iOldColor As eColorArt

'vorherige Werte merken
iOldDuplex = GetDuplexMode
iOldColor = GetColorMode
If bDebug = True Then Debug.Print "Duplex vor "; iOldDuplex, _
"Color vor "; iOldColor

'ggf. neue Werte setzen
If iOldDuplex iDuplexArt Then setDuplexMode iDuplexArt
If iOldColor iColorArt Then SetColorMode iColorArt
If bDebug = True Then Debug.Print "Duplex Job "; GetDuplexMode, _
"Color Job "; GetColorMode

'ausdrucken
If bDebug = False Then ActiveDocument.PrintOut Background:=bBackground

'vorherige Werte ggf. restaurieren
If iOldDuplex iDuplexArt Then setDuplexMode iOldDuplex
If iOldColor iColorArt Then SetColorMode iOldColor
If bDebug = True Then Debug.Print "Duplex nach "; GetDuplexMode, _
"Color nach "; GetColorMode

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ManGa · 26. Oktober 2016

sorry, falscher Thread *mrcool

zenger4ever · 21. Januar 2019

Hallo zusammen

Der Code funktioniert bei mir auf Win10/64-Word2016 nicht mehr.

Hat einer eine Lösung wie man per VBA-Code die Drucker-Standardeinstellungen auf farbig und einseitig wechselt?

Danke im Voraus!

Gruss zenger4ever

zenger4ever · 21. Januar 2019

Sorry, hat sich erledigt :-)

RookieOne · 4. Dezember 2019

Moin, zenger4ever,

Du schrubst

Sorry, hat sich erledigt :-)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hast Du eine Lösung für Windows 10 / Office 2016 gefunden?

Wir stellen demnächst auf Windows 10 / Office 2019 um.

Richtig zum Fliegen habe ich den VBA-Code für Farb- und einseitigen Druck leider nicht.

Gruß, RookieOne

haklesoft · 28. Januar 2021

von RookieOne

Wir stellen demnächst auf Windows 10 / Office 2019 um.

Richtig zum Fliegen habe ich den VBA-Code für Farb- und einseitigen Druck leider nicht.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wieso denn nicht? Für Office in einer 64-bit-Version muss man allerdings die API-Deklarationen mit PtrSafe erweitern.

igor61 · 14. November 2023

Hallo allerseits,

die API-Deklarationen mit PtrSafe erweitern hilft aber unter W11/Office64-Bit nicht mehr ganz. Die Routine steigt kurz vor dem Ende (Zeile 359) mit der Meldung "Typen unverträglich" aus:

'Load the printer properties into the byte array
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (iRet < 0) Then
'Couldn't access printer properties
GoTo cleanup
End If

Ich könnte da dringend Hilfe gebrauchen.

Office: (Office 2013) Druckereigenschaften per VBA einstellen

Druckereigenschaften per VBA einstellen

Druckereigenschaften per VBA einstellen

Druckereigenschaften per VBA einstellen

Druckereigenschaften per VBA einstellen

Anhänge:

WordVBA-DuplexPrint.docx (50,1 KB)

Druckereigenschaften per VBA einstellen

Druckereigenschaften per VBA einstellen - Similar Threads - Druckereigenschaften VBA einstellen

VBA Kopieren von Zelleninhalte in Textbox

VBA - Wenn Eintrag in Spalte vorhanden dann aktualisieren, sonst neue Zeile

VBA Textbox macht was sie will

Semikolon via VBA in einzelne Zellen separieren

VBA - Kopf- und Fußzeilen Anpassen mit Logos

VBA Code " Zeilenhöhe bei Verb. Zellen Funktioniert fasst"

Druckereigenschaften speichern