搜尋此網誌

2020年8月18日 星期二

用VBA控制單雙面列印Controlling the Printer from Word VBA

 在VBA中要控制印表機是一個不容易的事,應該沒有簡單的指令可以下,例如想控制印表機單、雙面例印、彩色、黑白...所以有高手寫了一串VBA,讓使用者可以簡單的在VBA中控制印表機,感謝Jonathan West的無私,已下是原文出處,他另有一程式可控制紙匣哦。

https://web.archive.org/web/20130915062449/http://pubs.logicalexpressions.com/Pub0009/LPMArticle.asp?ID=116

原文內容:

Controlling the Printer from Word VBA

by Jonathan West, MVP

Part 2: Using VBA to control Duplex, Color Mode and Print Quality

In last month's article, the Windows API was used to get information, from the printer, about the paper trays available in the printer. However, everything that was done in that article to control the printer was done through normal Word properties. However, there are no properties in Word to control the duplex, color mode or print quality, so we are going to have to control the printer for that, using more Windows API calls.

The main code routine that implements these calls is listed at the end of the article.

Printing in Color or Monochrome
If you have a color inkjet printer, it may often happen that you want to save money by printing in monochrome most of the time, and economize on expensive color ink. If you are printing a draft to check layout, you normally don't need color even if the document contains it. So, it would be nice to have a quick way of checking whether the color mode is set to color or monochrome. The main code routine at the end of this article has a GetColorMode function and a SetColorMode subroutine.

The color mode can take two possible values, as shown in the following table:

Value

Meaning

1

Monochrome

2

Color

The following code is an example of how to use the routines:

Sub AskBeforePrintingInColor()
    
    Dim iColor As Long


    iColor = GetColorMode
    If iColor = 2 Then
       If MsgBox("Do you really want to print in color?", _
              vbYesNo) = vbNo Then
          SetColorMode 1
       End If
    End If
    ActiveDocument.PrintOut Background:=False
    SetColorMode iColor

End Sub

This routine checks the color mode. If the color mode is currently color, it asks if you really want to print in color and changes to monochrome before printing if you answer no. The code restores the original color mode after printing.

Important Note! For all the printer properties set by the routines described in this article, if you change a setting, it is changed as the default printer setting for all applications (not just Word) until you set it back.

Printing Duplex
Duplex printing works in a very similar fashion to setting the color property, except that there are three possible values, as show in the table below:

Value

Meaning

1

Single-sided printing

2

Duplex printing using a horizontal binding

3

Duplex printing using a vertical binding

The vertical binding is the more commonly used duplex setting. With this setting, if you turn the page to the left, the text is the same way up on the other side of the page. In other words, if you bind the pages after printing, you would have a vertical binding on the left-hand side. You would use this setting for booklet printing.

Horizontal binding is for use when you want the binding horizontally on the top edge of the page. This is sometimes called tablet style.

The following diagram illustrates the two kinds of duplex printing.

Diagram image showing both horizontal and vertical binding. Horizontal shows page 1 at the top and page 2 bound below, with the binding going horizontally between the two pages. Vertical binding shows page 1 to the left, page 2 to the right, with the binding vertically between the two pages.

The following code will set the printer to duplex and print a document. This can be particularly useful in Word 2002 for a document set up as a booklet using the Bookfold option in File/Page Setup. The pages can then be stapled in the middle and folded to make the booklet.

Sub PrintDuplexBooklet()

    Dim iDuplex As Long

    iDuplex = GetDuplex     'save the current setting
    SetDuplex 3             'set for vertical binding
    ActiveDocument.PrintOut Background:=False
    SetDuplex iDuplex       'restore the original setting

End Sub

Setting the Print Quality
The possible values for the Print quality are show in the table below.

Value

Meaning

-1

Draft resolution

-2

Low resolution

-3

Medium resolution

-4

High resolution

Any positive value

The printer resolution in dots per inch (dpi)

The meaning of draftlowmedium and high resolution varies from printer to printer. In some cases it is simply an indication of varying resolution. In others, such as inkjet printers, lower-quality printing indicates that less ink is being used to print the page.

Some printers will return a negative value for the property, others will return a positive number giving the resolution, as measured in dots per inch.

In some cases the printer will accept being set with either positive or negative values of the property, others will ignore any requests they don't understand. The only way to know is to test with the specific printer you want to control.

The following code will print any document of more than 10 pages in draft mode

    Public Sub PrintLongDocsDraft()

    Dim iQuality As Long

    ActiveDocument.Repaginate
    If ActiveDocument.Range.Information(wdNumberOfPagesInDocument) > 10 Then
        iQuality = GetPrintQuality       'save the current setting
        SetPrintQuality -1
        ActiveDocument.PrintOut Background:=False
        SetPrintQuality iQuality         'restore the original setting
    End If

End Sub

Main Code for the Article
The following code should be pasted into a separate module. It contains the GetColorModeSetColorModeGetDuplexSetDuplexGetPrintQuality and SetPrintQuality routines that are used in the code samples above.

Important Note! Same warning as last month. Unless you are confident you know what you are doing, don't alter this code, just use it. Bugs in Windows API code don't just stop a macro, they can bring down Word or even Windows. If you're really keen to know how the code does what it does, I've put in plenty of comments so you can look through it.

Option Explicit

Private Type PRINTER_DEFAULTS
   pDatatype As 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_ORIENTATION = &H1
Private Const DM_PAPERSIZE = &H2
Private Const DM_PAPERLENGTH = &H4
Private Const DM_PAPERWIDTH = &H8
Private Const DM_DEFAULTSOURCE = &H200
Private Const DM_PRINTQUALITY = &H400
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_USE = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_NORMAL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
                PRINTER_ACCESS_USE)

Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_LOCAL = &H2

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 Function EnumPrinters Lib "winspool.drv" _
      Alias "EnumPrintersA" _
      (ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
      pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
      pcReturned As Long) As Long

Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
      (ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
      (ByVal Ptr As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
      (pDest As Any, pSource As Any, ByVal cbLength As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
      Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
      ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
      ByVal dev As Long) 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 SetDuplex(iDuplex As Long)
   SetPrinterProperty DM_DUPLEX, iDuplex
End Sub

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

Public Sub SetPrintQuality(iQuality As Long)
   SetPrinterProperty DM_PRINTQUALITY, iQuality
End Sub

Public Function GetPrintQuality() As Long
   GetPrintQuality = GetPrinterProperty(DM_PRINTQUALITY)
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
    sPrinterName = Trim$(Left$(ActivePrinter, _
          InStr(ActivePrinter, " on ")))
      
    pd.DesiredAccess = 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_ORIENTATION
       dm.dmOrientation = iPropertyValue
    Case DM_PAPERSIZE
       dm.dmPaperSize = iPropertyValue
    Case DM_PAPERLENGTH
       dm.dmPaperLength = iPropertyValue
    Case DM_PAPERWIDTH
       dm.dmPaperWidth = iPropertyValue
    Case DM_DEFAULTSOURCE
       dm.dmDefaultSource = iPropertyValue
    Case DM_PRINTQUALITY
       dm.dmPrintQuality = iPropertyValue
    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
  sPrinterName = Trim$(Left$(ActivePrinter, _
        InStr(ActivePrinter, " on ")))
      
  pd.DesiredAccess = 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_ORIENTATION
     GetPrinterProperty = dm.dmOrientation
  Case DM_PAPERSIZE
     GetPrinterProperty = dm.dmPaperSize
  Case DM_PAPERLENGTH
     GetPrinterProperty = dm.dmPaperLength
  Case DM_PAPERWIDTH
     GetPrinterProperty = dm.dmPaperWidth
  Case DM_DEFAULTSOURCE
     GetPrinterProperty = dm.dmDefaultSource
  Case DM_PRINTQUALITY
     GetPrinterProperty = dm.dmPrintQuality
  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


沒有留言:

張貼留言