1. 本示例程序演示了为报表设置打印参数。
2. 你可以用本示例为报表设置页面的页边距、纸张大小(包含自定义纸张)、页面方向等,还可以选择打印机,设置打印色彩模式、列布局、打印质量、打印份数以及打印范围等。
3. 本示例中所有的报表来自罗斯文数据库,你在使用时只需将本示例中的frmPrinter窗体和modPrinters模块导入到你的数据库文件即可。
4. 本示例部分代码来自网上。示例中的代码大多做了详细的注释,也有许多的垃圾代码没有删除,希望没有误导你。
5. 有些功能的实现是依据不同的打印机的,网上是这么说的,比如打印质量,有些打印机就不听你的,任你怎么设置都不为所动。
6. 因为本人的条件所限,并没有对示例中的所有功能进行测试,有条件的朋友可以试试,希望把你的测试结果共享。
部分源代码:
Option Compare Database
Option Explicit
Public Const strProTitle As String = "kangking 做的示例程序"
' 声明返回设置功能的 API 函数 DeviceCapabilities 。
Public Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal lpDevMode As Long) As Long
' DeviceCapabilities API 函数常数。
Public Const DC_FIELDS = 1
Public Const DC_PAPERS = 2
Public Const DC_PAPERSIZE = 3
Public Const DC_MINEXTENT = 4
Public Const DC_MAXEXTENT = 5
Public Const DC_BINS = 6
Public Const DC_DUPLEX = 7
Public Const DC_SIZE = 8
Public Const DC_EXTRA = 9
Public Const DC_VERSION = 10
Public Const DC_DRIVER = 11
Public Const DC_BINNAMES = 12
Public Const DC_ENUMRESOLUTIONS = 13
Public Const DC_FILEDEPENDENCIES = 14
Public Const DC_TRUETYPE = 15
Public Const DC_PAPERNAMES = 16
Public Const DC_ORIENTATION = 17
Public Const DC_COPIES = 18
Public Const DEFAULT_VALUES = 0
Public Type POINTS
x As Long
y As Long
End Type
Type str_PRTMIP
strRGB As String * 28
End Type
Type type_PRTMIP
lngLeftMargin As Long '左边距
lngTopMargin As Long '上边距
lngRightMargin As Long '右边距
lngBotMargin As Long '下边距
lngDataOnly As Long '仅数据
lngWidth As Long '主体高
lngHeight As Long '主体宽
lngDefaultSize As Long '默认尺寸
lngColumns As Long '列数
lngColumnSpacing As Long '列间距
lngRowSpacing As Long '行间距
lngItemLayout As Long '行列次序
lngFastPrint As Long '快速打印
lngDatasheet As Long '数据表
End Type
Type str_DEVMODE
RGB As String * 94
End Type
Type type_DEVMODE
strDeviceName As String * 32 '设备名称
intSpecVersion As Integer 'DEVMODE 结构的版本号
intDriverVersion As Integer '打印机驱动程序的版本号
intSize As Integer 'DEVMODE 结构的字节大小
intDriverExtra As Integer
lngFields As Long
intOrientation As Integer '指定纸张的打印方向
intPaperSize As Integer '打印的纸张的大小
intPaperLength As Integer '以 1/10 毫米为单位来指定纸张的长度
intPaperWidth As Integer '以 1/10 毫米为单位来指定纸张宽度
intScale As Integer '用于指定打印输出的缩放比例因子
intCopies As Integer '用于指定打印份数
intDefaultSource As Integer '用于指定默认送纸盒
intPrintQuality As Integer '用于指定打印机的分辨率。值可为 –4(高)、–3(中)、–2(低)和 –1(草稿)。
intColor As Integer '用于指定彩色打印机的输出是否为彩色。值可为 1(彩色)和 2(单色)。
intDuplex As Integer '用于指定可双面打印的打印机是否在纸张上进行双面打印输出。值为 1(单面)、2(水平)和 3(垂直)。
intResolution As Integer '以点/英寸 (dpi) 为单位指定打印机 y 轴方向的分辨率
intTTOption As Integer '用于指定如何打印 TrueType 字体
intCollate As Integer '在打印多个副本时,用于指定是否归类打印
strFormName As String * 32 '用于指定要使用的纸张大小
lngPad As Long
lngBits As Long
lngPW As Long
lngPH As Long
lngDFI As Long
lngDFr As Long
End Type
Sub ShowPrinters()
'本过程显示系统中打印机的信息。
'本过程是一个单独的过程,不为任何过程调用。
Dim strCount As String
Dim strMsg As String
Dim prtLoop As Printer
On Error GoTo ShowPrinters_Err
If Printers.Count > 0 Then
' 得到已经安装的打印机数量
strMsg = "已经安装的打印机数: " & Printers.Count & vbCrLf & vbCrLf
' 枚举打印机系统属性。
For Each prtLoop In Application.Printers
With prtLoop
strMsg = strMsg _
& "设备名称: " & .DeviceName & vbCrLf _
& "驱动名称: " & .DriverName & vbCrLf _
& "端口名称: " & .Port & vbCrLf _
& "上边距:" & .TopMargin & vbCrLf _
& "下边距:" & .BottomMargin & vbCrLf _
& "左边距:" & .LeftMargin & vbCrLf _
& "右边距:" & .RightMargin & vbCrLf _
& "主体列数:" & .ItemsAcross & vbCrLf _
& "列问距:" & .ColumnSpacing & vbCrLf _
& "行间距:" & .RowSpacing & vbCrLf _
& "主体布局:" & .ItemLayout & vbCrLf _
& "主体高:" & .ItemSizeHeight & vbCrLf _
& "主体宽:" & .ItemSizeWidth & vbCrLf _
& "色彩模式:" & .ColorMode & vbCrLf _
& "打印份数:" & .Copies & vbCrLf _
& "双面打印方法:" & .Duplex & vbCrLf _
& "仅打印数据:" & .DataOnly & vbCrLf _
& "页面方向:" & .Orientation & vbCrLf _
& "进纸槽:" & .PaperBin & vbCrLf _
& "页面尺寸:" & .PaperSize & vbCrLf _
& "默认尺寸:" & .DefaultSize & vbCrLf _
& "打印质量:" & .PrintQuality & vbCrLf & vbCrLf
End With
Next prtLoop
Else
strMsg = "没有安装打印机。"
End If
' 显示打印机信息。
MsgBox prompt:=strMsg, buttons:=vbOKOnly, title:=strProTitle
ShowPrinters_End:
Exit Sub
ShowPrinters_Err:
MsgBox prompt:="错误代码 " & Err.Number & vbCrLf & _
"错误描述 " & Err.Description, buttons:=vbCritical + vbOKOnly, _
title:=strProTitle
Resume ShowPrinters_End
End Sub