'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'分组报表显示分组页码和页数类模块(方法一)
'
'功    能:在有分组的报表的每一页上显示组页码和组页数，在预
'         览时改变页面设置后仍能正确显示。
'作    者: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

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'分组报表显示分组页码和页数类模块(方法二)
'
'功    能:在有分组的报表的每一页上显示组页码和组页数，在预
'         览时改变页面设置后仍能正确显示。
'作    者: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