Access报表打印设置

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