如果有人可以提供帮助,我有两个问题。我是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
答案 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代码示例:
此代码只有一个“问题”:它是为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