命令打印按钮。当我点击打印按钮时,第一页打印两次其他页面打印单个,这就是我想要的

时间:2017-08-03 12:54:07

标签: excel vba excel-vba

如果有人可以提供帮助,我有两个问题。我是VBA的新手。我的excel表上有一个命令打印按钮,我添加了下面列出的代码。当我点击打印按钮时,我将第一页打印两次,但其余页面打印单个,这就是我想要的。如何修复代码,使其只打印一次。 另一件事是打印管理器窗口打开我选择打印机,我想让代码选择单页打印而不是双面打印。打印机默认设置设置为双面打印,我不想通过窗口更改该设置,但代码可以自动选择单面打印。

谢谢,

Private Sub PrintAll_Click()

    Dim rngOffenders As Range
    Set rngOffenders = Worksheets("Names").Range("A2", Worksheets("Names").Range("A2").End(xlDown))

    Dim willPrint As Boolean
        willPrint = Application.Dialogs(xlDialogPrint).Show
        If Not willPrint Then Exit Sub

    Dim rng As Range
        For Each rng In rngOffenders.Cells
        Worksheets("Template").Range("LastName").Value = rng.Value
        Calculate
        Worksheets("Template").PrintOut
    Next rng

End Sub

2 个答案:

答案 0 :(得分:1)

关于重复打印,我的猜测是,在没有测试的情况下,通过Show打印对话框,一旦按下“确定”,就会对第一张/活动页面调用打印。然后,当您遍历rngOffenders.Cells时,您将再次打印该表。因此,您可以从rngOffenders中的第二个单元格开始,以避免这种情况。

Dim i As Long
For i = 2 To rngOffenders.Cells.Count
    Worksheets("Template").Range("LastName").Value = rngOffenders.Cells(i).Value
    Calculate
    Worksheets("Template").PrintOut
Next rng

对于打印机设置,这更复杂。见here

  

执行此操作的最佳方法是使用API​​调用。下面的文章为您提供了一个VB代码示例:

     

Q230743

     

此代码只有一个“问题”:它是为VB编写的,并使用Printer.DeviceName返回当前所选打印机的名称。在Word VBA中,您需要使用ActivePrinter替换它。问题是这些命令返回的字符串略有不同,即使它们都从控制面板中指定的名称获取打印机的名称。打印机。例如。:

     

ActivePrinter: LPT1上的HP LaserJet 6L PCL:

     

Printer.DeviceName: HP LaserJet 6L PCL

     

因此,您需要相应地测试和修改代码示例。

     

但是,如果您不想使用API​​调用,则可以安装具有双工属性集的重复打印机驱动程序并打印到该驱动程序(通过更改ActivePrinter)。

链接的知识库文章(最后)演示如何打印机设置为双面打印。大多数相同的代码应该用于逆操作,你只需要弄清楚该属性传递的值。

测试程序:

将其放入标准模块中。请注意可能需要调整打印机字符串的长度(删除端口组件,例如“HP Ink Jet Fantastico on LP02 ”等)

Option Explicit
Sub test()

    Dim pName As String
    pName = ActivePrinter
    ' Note you may need to adjust this value to remove the port string component
    pName = Left(pName, (Len(pName) - 9))

    SetPrinterDuplex pName, 1  '1 = NOT duplex printing.

    'Here you might want to actually print something, for example:
    Worksheets("Template").PrintOut

End Sub

在单独的模块中,放置所有与打印机相关的代码。注意:我在没有打印机访问权限的计算机上,因此我无法测试或进一步调试此解决方案。

Option Explicit

   Public Type PRINTER_DEFAULTS

       pDatatype As Long
       pDevmode As Long
       DesiredAccess As Long
   End Type

   Public 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

   Public 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

   Public Const DM_DUPLEX = &H1000&
   Public Const DM_IN_BUFFER = 8

   Public Const DM_OUT_BUFFER = 2
   Public Const PRINTER_ACCESS_ADMINISTER = &H4
   Public Const PRINTER_ACCESS_USE = &H8
   Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
   Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
             PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

   Public Declare Function ClosePrinter Lib "winspool.drv" _
    (ByVal hPrinter As Long) As Long
   Public 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
   Public 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
   Public Declare Function OpenPrinter Lib "winspool.drv" Alias _
     "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
     pDefault As PRINTER_DEFAULTS) As Long
   Public 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

   Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (pDest As Any, pSource As Any, ByVal cbLength As Long)

   ' ==================================================================
   ' SetPrinterDuplex
   '
   '  Programmatically set the Duplex flag for the specified printer
   '  driver's default properties.
   '
   '  Returns: True on success, False on error. (An error will also

   '  display a message box. This is done for informational value
   '  only. You should modify the code to support better error
   '  handling in your production application.)
   '
   '  Parameters:
   '    sPrinterName - The name of the printer to be used.
   '
   '    nDuplexSetting - One of the following standard settings:
   '       1 = None
   '       2 = Duplex on long edge (book)
   '       3 = Duplex on short edge (legal)
   '
   ' ==================================================================
   Public Function SetPrinterDuplex(ByVal sPrinterName As String, _
       ByVal nDuplexSetting As Long) As Boolean

      Dim hPrinter As Long
      Dim pd As PRINTER_DEFAULTS
      Dim pinfo As PRINTER_INFO_2
      Dim dm As DEVMODE

      Dim yDevModeData() As Byte
      Dim yPInfoMemory() As Byte
      Dim nBytesNeeded As Long
      Dim nRet As Long, nJunk As Long

      On Error GoTo cleanup

'#### I removed this block because it was preventing you from changing the duplex settings
'      If (nDuplexSetting < 1) Or (nDuplexSetting > 3) Then
'         MsgBox "Error: dwDuplexSetting is incorrect."
'         Exit Function
'      End If
'####

      pd.DesiredAccess = PRINTER_ALL_ACCESS
      nRet = OpenPrinter(sPrinterName, hPrinter, pd)
      If (nRet = 0) Or (hPrinter = 0) Then
         If Err.LastDllError = 5 Then
            MsgBox "Access denied -- See the article for more info."
         Else
            MsgBox "Cannot open the printer specified " & _
              "(make sure the printer name is correct)."
         End If
         Exit Function
      End If

      nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
      If (nRet < 0) Then
         MsgBox "Cannot get the size of the DEVMODE structure."
         GoTo cleanup
      End If

      ReDim yDevModeData(nRet + 100) As Byte
      nRet = DocumentProperties(0, hPrinter, sPrinterName, _
                  VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
      If (nRet < 0) Then
         MsgBox "Cannot get the DEVMODE structure."
         GoTo cleanup
      End If

      Call CopyMemory(dm, yDevModeData(0), Len(dm))

      If Not CBool(dm.dmFields And DM_DUPLEX) Then
        MsgBox "You cannot modify the duplex flag for this printer " & _
               "because it does not support duplex or the driver " & _
               "does not support setting it from the Windows API."
         GoTo cleanup
      End If

      dm.dmDuplex = nDuplexSetting
      Call CopyMemory(yDevModeData(0), dm, Len(dm))

      nRet = DocumentProperties(0, hPrinter, sPrinterName, _
        VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
        DM_IN_BUFFER Or DM_OUT_BUFFER)

      If (nRet < 0) Then
        MsgBox "Unable to set duplex setting to this printer."
        GoTo cleanup
      End If

      Call GetPrinter(hPrinter, 2, 0, 0, nBytesNeeded)
      If (nBytesNeeded = 0) Then GoTo cleanup

      ReDim yPInfoMemory(nBytesNeeded + 100) As Byte

      nRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), nBytesNeeded, nJunk)
      If (nRet = 0) Then
         MsgBox "Unable to get shared printer settings."
         GoTo cleanup
      End If

      Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))
      pinfo.pDevmode = VarPtr(yDevModeData(0))
      pinfo.pSecurityDescriptor = 0
      Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

      nRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)
      If (nRet = 0) Then
         MsgBox "Unable to set shared printer settings."
      End If

      SetPrinterDuplex = CBool(nRet)

cleanup:
      If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

   End Function

答案 1 :(得分:-1)

您可以像这样打印第一页:

Dim i As Long, k As Long
Dim lpc As Long

lpc = ActiveSheet.HPageBreaks.Count

 For i = 1 To lpc + 1
    If i = 1 Then
    k = 2
    Else
    k = 1
    End If
ActiveSheet.PrintOut from:=i, To:=i, Copies:=k
 Next