Access 报表打印之分组页码实现(轉)

/Files/Tonyyang/报表分组页码V1.2.rar

 

Option Compare Database
Option  Explicit

' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 分组报表显示分组页码和页数类模块(方法一)
'
' 功    能:在有分组的报表的每一页上显示组页码和组页数，在预
'          览时改变页面设置后仍能正确显示。
' 作    者:t小雨(tcl013@126.com)(t小宝)
' 版    本:1.1
' 创建日期:2008-05-??
' 整理日期:2008-05-30
' 补充说明:这个代码是一年前做的，由于实现原理和过程有点复杂，
'          当时没有添加注释，已忘得差不多，加上表达能力有限，
'          现在勉强添加了不完全的注释，但能依照说明会用就行。
'          直接把代码放到报表中也是可以。
'          做成类模块只是为了好保存，以后调用方便，但由于在
'          类模块中不能使用报表的节的事件，调用起来还是有些
'          麻烦，不过总要比直接把代码放在报表简单一点。
'
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

' 实现原理：
' 通过报表上的辅助文本框获得组的总行数(记录数,后同)、1页的最大行数、当前页在当前组的截止行数，
' 在页面页脚_Format事件中通过计算得到分组页码和页数。

' 报表设计要求：
'  1、报表应包含组页眉、页面页眉、页面页脚
'  2、在组页眉上有一文本框，有如下属性
'     ControlSource(控件来源)="=Count(*)"
'     RunningSum(运行总和)=0(不)
'  3、在主体有一文本框，有如下属性
'     ControlSource(控件来源)="=1"
'     RunningSum(运行总和)=1(工作组之上)

' 调用方法，有2种：
'  第1种:
'  1、在报表用New关键字声明一个 CreateGroupPage1 类的新实例
'  2、在报表的打开事件执行实例的 Init 方法,传入全部参数
'  3、在页面页脚的 Format (格式化)事件执行实例的 FormatPageFooter 方法
'  4、在页面页脚的 Print (打印)事件执行实例的 PrintPageFooter 方法
'  这种方法在显示分组页码的标签上显示效果如 分组字段值: 1 / 2
'  在报表中的代码类似下面:

' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Dim newGroupPage As New CreateGroupPage1
'
'  Private Sub Report_Open(Cancel As Integer)
'      newGroupPage.Init Me, Me.TxtGrpRows, Me.txtRunSum, Me.LplGrpPages
'  End Sub
'
'  Private Sub 页面页脚_Format(Cancel As Integer, FormatCount As Integer)
'      newGroupPage.FormatPageFooter
'  End Sub
'
'  Private Sub 页面页脚_Print(Cancel As Integer, PrintCount As Integer)
'      newGroupPage.PrintPageFooter
'  End Sub
'
'  Private Sub 组页眉0_Format(Cancel As Integer, FormatCount As Integer)
'      newGroupPage.FormatGroupLevel1Header
'  End Sub
'
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'  第2种:
'  1、在报表用 WithEvents 关键字声明一个 CreateGroupPage1 类的变量
'  2、在报表的打开事件用 Set New 语句创建新实例
'  3、在报表的打开事件执行实例的 Init 方法,不须传入最后一个参数(用于显示分组页码的标签)
'  4、在页面页脚的 Format(格式化) 事件执行实例的 FormatPageFooter 方法
'  5、在页面页脚的 Print(打印) 事件执行实例的 PrintPageFooter 方法
'  6、在组页眉的 Format(格式化) 事件执行实例的 FormatGroupLevel1Header 方法
'  7、在类的 Current 事件过程将事件参数返回的分组页码和页数赋给用于显示的标签
'  在报表中的代码类似下面:

' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Dim WithEvents newGroupPage As CreateGroupPage1
'
'  Private Sub Report_Open(Cancel As Integer)
'      Set newGroupPage = New CreateGroupPage1
'      newGroupPage.Init Me, Me.TxtGrpRows, Me.txtRunSum
'  End Sub
'
'  Private Sub 页面页脚_Format(Cancel As Integer, FormatCount As Integer)
'      newGroupPage.FormatPageFooter
'  End Sub
'
'  Private Sub 页面页脚_Print(Cancel As Integer, PrintCount As Integer)
'      newGroupPage.PrintPageFooter
'  End Sub
'
'  Private Sub 组页眉0_Format(Cancel As Integer, FormatCount As Integer)
'      newGroupPage.FormatGroupLevel1Header
'  End Sub
'
'  Private Sub newGroupPage_Current(GrpPage As Integer, GrpPages As Integer)
'      Me.LplGrpPages.Caption = Me.类别名称 & " 共 " & GrpPages & " 页,第 " & GrpPage & " 页"
'  End Sub
'
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Event Current(GrpPage  As  Integer, GrpPages  As  Integer)
' 在此自定义事件中可以获取分组页码信息，以便自定义显示页码格式

Dim MyRpt  As Report
Dim txtRunSum  As TextBox            '  取得每个组的记录数的文本框
Dim TxtGrpRows  As TextBox           '  取得每个组的记录在组中的序号的文本框
Dim lblShowPage  As Label            '  用于显示分组页码信息的标签

Dim inMaxRows  As  Integer            '  1页的最大行数(记录数)
Dim inRptPage  As  Integer            '  报表本身页码
Dim blPrint  As  Boolean              '  是否已经发生页面页脚的Print事件,为避免页面页脚的Format事件中的代码重复运行
Dim blFistPage  As  Boolean           '  当前页是否是所在组的第一页

Public  Sub Init(rpt  As Report, GrpRows  As TextBox, RunSum  As TextBox, Optional ShowPage  As Label)
'  过程中的检查参数代码不是必须的，仅为了防止以后忘记如何设计报表

     Dim st1  As  String

     Set MyRpt = rpt
    
     Set TxtGrpRows = GrpRows
     With TxtGrpRows
         If .Section <> acGroupLevel1Header  Then
            st1 =  " 作为第二个参数的文本框必须在分组页眉节上！ "
         ElseIf .ControlSource <>  " =Count(*) "  Then
            st1 =  " 作为第二个参数的文本框的ControlSource属性必须是""=Count(*)""！ "
         ElseIf .RunningSum <>  0  Then
            st1 =  " 作为第二个参数的文本框的RunningSum属性必须是0！ "
         End  If
     End  With
     If  Len(st1) >  0  Then
         MsgBox st1, vbExclamation,  " 参数错误 "
         Exit  Sub
     End  If
    
     Set txtRunSum = RunSum
     With txtRunSum
         If .Section <> acDetail  Then
             st1 =  " 作为第三个参数的文本框必须在报表主体节上！ "
         ElseIf .ControlSource <>  " =1 "  Then
            st1 =  " 作为第三个参数的文本框的ControlSource属性必须是""=1""！ "
         ElseIf .RunningSum <>  1  Then
            st1 =  " 作为第三个参数的文本框的RunningSum属性必须是1！ "
         End  If
     End  With
     If  Len(st1) >  0  Then
         MsgBox st1, vbExclamation,  " 参数错误 "
         Exit  Sub
     End  If
    
     If  Not (ShowPage  Is  Nothing)  Then  Set lblShowPage = ShowPage
   
End Sub

Public  Sub FormatGroupLevel1Header()
     If txtRunSum =  1  Then blFistPage =  True            '  为页面页脚Format事件作标记
End Sub

Public  Sub FormatPageFooter()

     Dim inGrpPage  As  Integer            '  组页码
     Dim inGrpPages  As  Integer           '  组页数
     Dim inLastRows  As  Integer           '  截止当前页,所在组的所有行数

    inLastRows = txtRunSum                                        '  从文本框获得截止行数
     If inLastRows =  0  Then inLastRows = TxtGrpRows
    
     If MyRpt.Page =  1  Then
     ' 在第1页初始变量
         If MyRpt.Pages >  0  And MyRpt.Pages = inRptPage  Then
         '  这里已经是第2轮格式化第1页，报表加载时进行两轮格式化，第一轮Pages=0
         Else
            inMaxRows =  0
         End  If
        inRptPage =  0
        blPrint =  False
     End  If
    
     If  Not blPrint  Then
     ' 仅在第1轮格式化中,获取每组第一页的行数
         If blFistPage  Then
         ' 每组第一页的行数即是本组任一页的最大行数
             If inMaxRows < inLastRows  Then inMaxRows = inLastRows
            blFistPage =  False
         End  If
        inRptPage = inRptPage +  1
     End  If
    
     If MyRpt.Pages >  0  Then
        inGrpPages =  Int(TxtGrpRows / inMaxRows +  0.9999)          '  组的总行数除以1页的行数，得到组的页数
        inGrpPage =  Int(inLastRows / inMaxRows +  0.9999)           '  截止当前页的累计行数除以1页的行数，得到当前页的页码
         If  Not (lblShowPage  Is  Nothing)  Then
            lblShowPage.Caption = inGrpPage &  "  /  " & inGrpPages
         End  If
        RaiseEvent Current(inGrpPage, inGrpPages)
     End  If

End Sub

Public  Sub PrintPageFooter()
    blPrint =  True
End Sub

 

方法二：

 

Option Compare Database
Option Explicit

' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 分组报表显示分组页码和页数类模块(方法二)
'
' 功    能:在有分组的报表的每一页上显示组页码和组页数，在预
'          览时改变页面设置后仍能正确显示。
' 作    者:t小雨(tcl013@126.com)(t小宝)
' 版    本:1.1
' 创建日期:2008-05-??
' 整理日期:2008-05-30
' 补充说明:这个代码是一年前做的，由于实现原理和过程相当复杂，
'          当时没有添加注释，已忘得差不多，加上表达能力有限，
'          现在勉强添加了不完全的注释，但能依照说明会用就行。
'          直接把代码放到报表中也是可以。
'          做成类模块只是为了好保存，以后调用方便，但由于在
'          类模块中不能使用报表的节的事件，调用起来还是有些
'          麻烦，不过总要比直接把代码放在报表简单一点。
'
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

' 实现原理：
'  报表加载后：会发生两轮从第1页到最后1页每页的格式化事件，每轮结束后发生一次打印事件，
'  在第一轮格式化事件中报表的Pages属性始终为0。最后还会移到第一页。
'  重设纸张边距、方向或大小等后也发生类似上述过程，情况相对复杂一点，就不细说了。
'  在这些事件中把页码信息保存到数组中，数组元素和报表页数一样，每个元素代表一页的信息。
'  移动页后：也会发生一次格式化事件，在这些事件中把数组中页码的信息显示出来。
'  上面所说的事件都是页面页脚的事件。

' 报表设计要求：
'  很简单，有一个分组字段和页面页脚即可

' 调用方法有2种：
'  第1种:
'  1、在报表用New关键字声明一个 CreateGroupPage2 类的新实例
'  2、在报表的打开事件执行实例的 Init 方法,传入报表、分组字段和用于显示分组页码的标签
'  3、在页面页脚的 Format (格式化)事件执行实例的 FormatPageFooter 方法
'  4、在页面页脚的 Print (打印)事件执行实例的 PrintPageFooter 方法
'  这种方法在显示分组页码的标签上显示效果如 分组字段值: 1 / 2
'  在报表中的代码类似下面:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Dim newGroupPage As New CreateGroupPage2
'
'   Private Sub Report_Open(Cancel As Integer)
'       newGroupPage.Init Me, Me.类别ID, Me.LplGrpPages
'   End Sub
'
'   Private Sub 页面页脚_Format(Cancel As Integer, FormatCount As Integer)
'       newGroupPage.FormatPageFooter
'   End Sub
'
'   Private Sub 页面页脚_Print(Cancel As Integer, PrintCount As Integer)
'       newGroupPage.PrintPageFooter
'   End Sub
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'  第2种:
'  1、在报表用 WithEvents 关键字声明一个 CreateGroupPage2 类的变量
'  2、在报表的打开事件用 Set New 语句创建新实例
'  3、在报表的打开事件执行实例的 Init 方法,传入报表、分组字段,不须传入用于显示分组页码的标签
'  4、在页面页脚的 Format(格式化) 事件执行实例的 FormatPageFooter 方法
'  5、在页面页脚的 Print(打印) 事件执行实例的 PrintPageFooter 方法
'  6、在类的 Current 事件过程将事件参数返回的分组页码和页数赋给用于显示的标签
'  在报表中的代码类似下面:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Dim WithEvents newGroupPage As CreateGroupPage2
'
'   Private Sub Report_Open(Cancel As Integer)
'       Set newGroupPage = New CreateGroupPage2
'       newGroupPage.Init Me, Me.类别ID, Me.LplGrpPages
'   End Sub
'
'   Private Sub 页面页脚_Format(Cancel As Integer, FormatCount As Integer)
'       newGroupPage.FormatPageFooter
'   End Sub
'
'   Private Sub 页面页脚_Print(Cancel As Integer, PrintCount As Integer)
'       newGroupPage.PrintPageFooter
'   End Sub
'
'   Private Sub newGroupPage_Current(GrpPage As Integer, GrpPages As Integer)
'       Me.LplGrpPages.Caption = Me.类别名称 & " 共 " & GrpPages & " 页,第 " & GrpPage & " 页"
'   End Sub
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  这种方法在显示分组页码的标签上显示效果是自定义的


Public Event Current(GrpPage As Integer, GrpPages As Integer)
' 在此自定义事件中可以获取分组页码信息，以便自定义显示页码格式

Dim MyRpt As Report
Dim ctrGroup As Control
Dim lblShowPage As Label

Dim blPrint As Boolean             '  是否已经发生页面页脚的Print事件,为避免页面页脚的Format事件中的代码重复运行
Dim stGroupText As String          '  分组字段值

Dim inRptPage As Integer           '  报表页号
Dim inGrpPage As Integer           '  组页号

Dim ainGrpPage() As Integer        '  保存组页号的数组,用于显示
Dim ainGrpPages() As Integer       '  保存每个组的总页数的数组,用于显示

Dim ainGrpPageTmp() As Integer     '  保存组页号的数组,临时
Dim ainGrpPagesTmp() As Integer    '  保存每个组的总页数的数组,临时


Public Sub Init(rpt As Report, Group As Control, Optional ShowPage As Label)
' rpt      :报表本身,必须
' Group    :用于分组的字段,必须
' ShowPage :用于显示分组页码的标签,可选

    Set MyRpt = rpt
    Set ctrGroup = Group
    If Not (ShowPage Is Nothing) Then Set lblShowPage = ShowPage

End Sub


Public Sub FormatPageFooter()

Dim inShowGrpPage As Integer            '  显示的组页码
Dim inShowGrpPages As Integer           '  显示的组页数
Dim i As Integer, j As Integer

If MyRpt.Page =  1 Then
'  在第1页初始变量

    If inRptPage >  0 And inRptPage = MyRpt.Pages Then
     '  报表加载后第一轮格式化完毕发生
        For j = inRptPage - inGrpPage +  1 To inRptPage    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ainGrpPagesTmp(j) = inGrpPage                 '
        Next                                              '
        ReDim ainGrpPage( 1 To inRptPage)                  '  这一段代码与后面一段代码一样，因为后面无法判断加载完成
        ReDim ainGrpPages( 1 To inRptPage)                 '
        For i =  1 To inRptPage                            '
            ainGrpPage(i) = ainGrpPageTmp(i)              '
            ainGrpPages(i) = ainGrpPagesTmp(i)            '
        Next                                              '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    End If
    
    inRptPage =  0
    inGrpPage =  0
    stGroupText =  ""
    blPrint = False
End If

If Not blPrint Then
' 仅在第一轮格式化中获取页位置，保存到临时数组
    inRptPage = inRptPage +  1
    ReDim Preserve ainGrpPageTmp( 1 To inRptPage)
    ReDim Preserve ainGrpPagesTmp( 1 To inRptPage)
    
    If stGroupText = ctrGroup Then                       '  当前页与上一页在同一组
        inGrpPage = inGrpPage +  1                        '  累计本组页数，也即获得当前页在当前组中的页码
    Else                                                 '  当前页与上一页不在同一组，换组
        For j = inRptPage - inGrpPage To inRptPage -  1   '  循环上一组的每一页
            ainGrpPagesTmp(j) = inGrpPage                '  每个元素都储存总页数，页在组中的最大序号即总页数
        Next
        inGrpPage =  1                                    '  重新开始累计本组页数
        stGroupText = ctrGroup
    End If

    ainGrpPageTmp(inRptPage) = inGrpPage                 '  每个元素都储存页在组中的页码
End If

If MyRpt.Page = MyRpt.Pages Then
' 报表已打开后重设纸张边距大小方向等会发生
    If inRptPage = MyRpt.Pages Then
     ' 仅在最后一页把临时数组中的页码信息更新到用于显示页码的数组
        For j = inRptPage - inGrpPage +  1 To inRptPage
            ainGrpPagesTmp(j) = inGrpPage                '  这个循环代码与上面有重复，因为上面无法判断最后一页
        Next
        
        ReDim ainGrpPage( 1 To inRptPage)                 '  数组大小为报表页数
        ReDim ainGrpPages( 1 To inRptPage)
        For i =  1 To inRptPage
            ainGrpPage(i) = ainGrpPageTmp(i)
            ainGrpPages(i) = ainGrpPagesTmp(i)
        Next
    End If
End If

On Error Resume Next

If MyRpt.Pages >  0 Then
    inShowGrpPages = ainGrpPages(MyRpt.Page)    '
    inShowGrpPage = ainGrpPage(MyRpt.Page)     '
    If Not (lblShowPage Is Nothing) Then lblShowPage.Caption = _
        ctrGroup &  " :  " & inShowGrpPage &  "  /  " & inShowGrpPages
    RaiseEvent Current(inShowGrpPage, inShowGrpPages)
End If

End Sub

Public Sub PrintPageFooter()
'  区分两轮格式化
    blPrint = True
End Sub

 

 

转载于:https://www.cnblogs.com/Tonyyang/archive/2011/11/21/2256843.html