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 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
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
欢迎转载，转载请注明出处：http://www.cnblogs.com/Tonyyang/
