Word VBA duplex drucken

[Alberto]

Hallo zusammen,

gern möchte ich erneut Eure Hilfe in Anspruch nehmen.
Ich habe ein Word-Dokument, das allerdings vierseitig ist und beidseitig 4 MAL bedruckt werden soll.
Mit dem folgenden Code "Makro aufgezeichnet" kann man einseitig drucken, aber beidseitig klappt es leider nicht.
 
Sub Makro1()
'
 
    Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentWithMarkup, Copies:=2, Pages:="", PageType:= _
        wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
        PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
End Sub
 
Ich möchte das als Button in der Worddatei einfügen. Der Button muss nicht sichtbar sein auf dem bedruckten Blatt.
habt ihr eine Idee oder Möglichkeit wie ich hier vorgehen muss?? 

Bin für jede Hilfe dankbar!!

Alberto

[schauan]

Hallöchen,

erstelle einen zweiten Drucker, bei dem Duplex Standard ist. Zum Drucken steuerst Du den dann an.
Buttons haben eine entsprechende Eigenschaft, dass sie nicht mit ausgedruckt werden.

[Alberto]

Hallöchen,

erstelle einen zweiten Drucker, bei dem Duplex Standard ist. Zum Drucken steuerst Du den dann an.
Buttons haben eine entsprechende Eigenschaft, dass sie nicht mit ausgedruckt werden.

Hallo,
danke für deine Antwort.
Ich habe versucht einen zweiten Drucker zu erstellen, bei dem Duplex Standard ist aber der Drucker druckt nur einseitig
Wie heißt die Eigenschaft, dass der Button nicht mit ausgedruckt wird, da ich im Bereich nicht vo viele Anhnung habe.

[schauan]

Hallöchen,

die Eigenschaft heißt "Objekt drucken"

kann der Drucker denn Duplex?

wie hast Du den Drucker vor dem Drucken gewechselt?

[Alberto]

Hallo zusammen,

Ich konnte durch den unteren Code Duplex drucken ohne Probleme aber nur ein Blatt beidseitig.
Wo kann ich im Code ändern damit ich 4 Blätter beidseitig ausdrucken kann.
Danke im Voraus.
Alberto


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

[Alberto]

Hallo,

ich warte seit Tagen auf eine Antwort aber bis jetzt habe ich  keine Rückmeldung bekommen.
Der Code Kann NUR ein Blatt beidseitig ohne Probleme drucken aber ich möchte 4 Blätter beidseitig ausdrucken.
Wo kann ich das im Code ändern damit ich 4 Blätter beidseitig ausdrucken kann.

Für eine baldige Antwort danke ich euch im Voraus.

Gruß
Alberto

[schauan]

Hallöchen,

da hat wohl kaum einer einen duplexfähigen Drucker zur Hand und gleich gar nicht Deinen... Und wenn der Drucker mit Standardeinstellung Duplex auch nur einseitig druckt, wie Du schriebst, bekommt man aus der Ferne ein paar graue haare mehr als nötig

[Kuwer]

Hallo Alberto,


vielleicht so?

Code:

  'ausdrucken
    If bDebug = False Then ActiveDocument.PrintOut Background:=True, PageType:=wdPrintAllPages, Copies:=2

Gruß Uwe

[Alberto]

Hallo Uwe,

ich habe es probiert, aber es hat leider nicht geklappt.
Ich Danke Dir für deine Mühe.
Ich glaube, ich werde Duplex einfach manuell drucken

Viele Grüße
Alberto