报表分组页码终极解决方案

t小宝

最近又看到在关报表分组页码的帖子，也来凑下热闹。
一年前曾要使用在报表显示分组页码和页数的功能，网上苦苦寻觅而不得，于是硬着头皮研究，终于得出
两种方法。
后来才发现2004年在access中国已经有人提出这样的问题，并有解决方法，是这个帖子：
http://www.office-cn.net/forum.php?mod=viewthread&tid=19213&highlight=%D7%E9%2B%D2%B3
不过在预览报表时改变页面设置（边距、大小、方向等）后，页码显示出现错乱；
再后来又在微软网站看到一篇专门解决此问题的kb文章：
http://support.microsoft.com/kb/841779/zh-cn?spid=1265&sid=98，
其需要另建一个表，并使用记录集，显示效果比较好，但在某些情况下改变页面设置还是会出现页码显示
错乱。
而本人的方法经本人测试，改变页面设置无页码显示错乱现象，因此斗胆称为终极解决方案，请大家测试
和批评，也许还有更好的方法。
做成了类模块，有一点注释但很难讲明白，如果谁要研究实现原理可以和我交流。其实上面说的两个方法的实现原
理我也不清楚，很多事情知道用就行了。


'分组报表显示分组页码和页数(方法一)
'
'功    能:在有分组的报表的每一页上显示组页码和组页数，在预
'         览时改变页面设置后仍能正确显示。
'作    者:t小雨([email=tcl013@126.com)(t]tcl013@126.com)(t[/email]小宝)
'版    本:1.1
'创建日期:2008-05-??
'整理日期:2009-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
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
类模块：

1. Option Compare Database
   
2. Option Explicit
   
3. Public Event Current(GrpPage As Integer, GrpPages As Integer)
   
4. '在此自定义事件中可以获取分组页码信息，以便自定义显示页码格式
   
5. Dim MyRpt As Report
   
6. Dim txtRunSum As TextBox           ' 取得每个组的记录数的文本框
   
7. Dim TxtGrpRows As TextBox          ' 取得每个组的记录在组中的序号的文本框
   
8. Dim lblShowPage As Label           ' 用于显示分组页码信息的标签
   
9. Dim inMaxRows As Integer           ' 1页的最大行数(记录数)
   
10. Dim inRptPage As Integer           ' 报表本身页码
    
11. Dim blPrint As Boolean             ' 是否已经发生页面页脚的Print事件,为避免页面页脚的Format事件中的代码重复运行
    
12. Dim blFistPage As Boolean          ' 当前页是否是所在组的第一页
    
13. Public Sub Init(rpt As Report, GrpRows As TextBox, RunSum As TextBox, Optional ShowPage As Label)
    
14. ' 过程中的检查参数代码不是必须的，仅为了防止以后忘记如何设计报表
    
15.     Dim st1 As String
    
16.     Set MyRpt = rpt
    
17.    
    
18.     Set TxtGrpRows = GrpRows
    
19.     With TxtGrpRows
    
20.         If .Section <> acGroupLevel1Header Then
    
21.             st1 = "作为第二个参数的文本框必须在分组页眉节上！"
    
22.         ElseIf .ControlSource <> "=Count(*)" Then
    
23.             st1 = "作为第二个参数的文本框的ControlSource属性必须是""=Count(*)""！"
    
24.         ElseIf .RunningSum <> 0 Then
    
25.             st1 = "作为第二个参数的文本框的RunningSum属性必须是0！"
    
26.         End If
    
27.     End With
    
28.     If Len(st1) > 0 Then
    
29.         MsgBox st1, vbExclamation, "参数错误"
    
30.         Exit Sub
    
31.     End If
    
32.    
    
33.     Set txtRunSum = RunSum
    
34.     With txtRunSum
    
35.         If .Section <> acDetail Then
    
36.              st1 = "作为第三个参数的文本框必须在报表主体节上！"
    
37.         ElseIf .ControlSource <> "=1" Then
    
38.             st1 = "作为第三个参数的文本框的ControlSource属性必须是""=1""！"
    
39.         ElseIf .RunningSum <> 1 Then
    
40.             st1 = "作为第三个参数的文本框的RunningSum属性必须是1！"
    
41.         End If
    
42.     End With
    
43.     If Len(st1) > 0 Then
    
44.         MsgBox st1, vbExclamation, "参数错误"
    
45.         Exit Sub
    
46.     End If
    
47.    
    
48.     If Not (ShowPage Is Nothing) Then Set lblShowPage = ShowPage
    
49.    
    
50. End Sub
    
51. Public Sub FormatGroupLevel1Header()
    
52.     If txtRunSum = 1 Then blFistPage = True           ' 为页面页脚Format事件作标记
    
53. End Sub
    
54. Public Sub FormatPageFooter()
    
55.     Dim inGrpPage As Integer           ' 组页码
    
56.     Dim inGrpPages As Integer          ' 组页数
    
57.     Dim inLastRows As Integer          ' 截止当前页,所在组的所有行数
    
58.     inLastRows = txtRunSum                                       ' 从文本框获得截止行数
    
59.     If inLastRows = 0 Then inLastRows = TxtGrpRows
    
60.    
    
61.     If MyRpt.Page = 1 Then
    
62.     '在第1页初始变量
    
63.         If MyRpt.Pages > 0 And MyRpt.Pages = inRptPage Then
    
64.         ' 这里已经是第2轮格式化第1页，报表加载时进行两轮格式化，第一轮Pages=0
    
65.         Else
    
66.             inMaxRows = 0
    
67.         End If
    
68.         inRptPage = 0
    
69.         blPrint = False
    
70.     End If
    
71.    
    
72.     If Not blPrint Then
    
73.     '仅在第1轮格式化中,获取每组第一页的行数
    
74.         If blFistPage Then
    
75.         '每组第一页的行数即是本组任一页的最大行数
    
76.             If inMaxRows < inLastRows Then inMaxRows = inLastRows
    
77.             blFistPage = False
    
78.         End If
    
79.         inRptPage = inRptPage + 1
    
80.     End If
    
81.    
    
82.     If MyRpt.Pages > 0 Then
    
83.         inGrpPages = Int(TxtGrpRows / inMaxRows + 0.9999)         ' 组的总行数除以1页的行数，得到组的页数
    
84.         inGrpPage = Int(inLastRows / inMaxRows + 0.9999)          ' 截止当前页的累计行数除以1页的行数，得到当前页的页码
    
85.         If Not (lblShowPage Is Nothing) Then
    
86.             lblShowPage.Caption = inGrpPage & " / " & inGrpPages
    
87.         End If
    
88.         RaiseEvent Current(inGrpPage, inGrpPages)
    
89.     End If
    
90. End Sub
    
91. Public Sub PrintPageFooter()
    
92.     blPrint = True
    
93. End Sub
    
94. 
    

复制代码

t小宝

'分组报表显示分组页码和页数(方法二)
'
'功    能:在有分组的报表的每一页上显示组页码和组页数，在预
'         览时改变页面设置后仍能正确显示。
'作    者:t小雨([email=tcl013@126.com)(t]tcl013@126.com)(t[/email]小宝)
'版    本:1.1
'创建日期:2008-05-??
'整理日期:2009-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
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 这种方法在显示分组页码的标签上显示效果是自定义的

类模块：

1. Option Compare Database
   
2. Option Explicit
   
3. Public Event Current(GrpPage As Integer, GrpPages As Integer)
   
4. '在此自定义事件中可以获取分组页码信息，以便自定义显示页码格式
   
5. Dim MyRpt As Report
   
6. Dim ctrGroup As Control
   
7. Dim lblShowPage As Label
   
8. Dim blPrint As Boolean            ' 是否已经发生页面页脚的Print事件,为避免页面页脚的Format事件中的代码重复运行
   
9. Dim stGroupText As String         ' 分组字段值
   
10. Dim inRptPage As Integer          ' 报表页号
    
11. Dim inGrpPage As Integer          ' 组页号
    
12. Dim ainGrpPage() As Integer       ' 保存组页号的数组,用于显示
    
13. Dim ainGrpPages() As Integer      ' 保存每个组的总页数的数组,用于显示
    
14. Dim ainGrpPageTmp() As Integer    ' 保存组页号的数组,临时
    
15. Dim ainGrpPagesTmp() As Integer   ' 保存每个组的总页数的数组,临时
    
16. 
    
17. Public Sub Init(rpt As Report, Group As Control, Optional ShowPage As Label)
    
18. 'rpt      :报表本身,必须
    
19. 'Group    :用于分组的字段,必须
    
20. 'ShowPage :用于显示分组页码的标签,可选
    
21.     Set MyRpt = rpt
    
22.     Set ctrGroup = Group
    
23.     If Not (ShowPage Is Nothing) Then Set lblShowPage = ShowPage
    
24. End Sub
    
25. 
    
26. Public Sub FormatPageFooter()
    
27. Dim inShowGrpPage As Integer           ' 显示的组页码
    
28. Dim inShowGrpPages As Integer          ' 显示的组页数
    
29. Dim i As Integer, j As Integer
    
30. If MyRpt.Page = 1 Then
    
31. ' 在第1页初始变量
    
32.     If inRptPage > 0 And inRptPage = MyRpt.Pages Then
    
33.     ' 报表加载后第一轮格式化完毕发生
    
34.         For j = inRptPage - inGrpPage + 1 To inRptPage   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
35.             ainGrpPagesTmp(j) = inGrpPage                '
    
36.         Next                                             '
    
37.         ReDim ainGrpPage(1 To inRptPage)                 ' 这一段代码与后面一段代码一样，因为后面无法判断加载完成
    
38.         ReDim ainGrpPages(1 To inRptPage)                '
    
39.         For i = 1 To inRptPage                           '
    
40.             ainGrpPage(i) = ainGrpPageTmp(i)             '
    
41.             ainGrpPages(i) = ainGrpPagesTmp(i)           '
    
42.         Next                                             '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
43.     End If
    
44.    
    
45.     inRptPage = 0
    
46.     inGrpPage = 0
    
47.     stGroupText = ""
    
48.     blPrint = False
    
49. End If
    
50. If Not blPrint Then
    
51. '仅在第一轮格式化中获取页位置，保存到临时数组
    
52.     inRptPage = inRptPage + 1
    
53.     ReDim Preserve ainGrpPageTmp(1 To inRptPage)
    
54.     ReDim Preserve ainGrpPagesTmp(1 To inRptPage)
    
55.    
    
56.     If stGroupText = ctrGroup Then                      ' 当前页与上一页在同一组
    
57.         inGrpPage = inGrpPage + 1                       ' 累计本组页数，也即获得当前页在当前组中的页码
    
58.     Else                                                ' 当前页与上一页不在同一组，换组
    
59.         For j = inRptPage - inGrpPage To inRptPage - 1  ' 循环上一组的每一页
    
60.             ainGrpPagesTmp(j) = inGrpPage               ' 每个元素都储存总页数，页在组中的最大序号即总页数
    
61.         Next
    
62.         inGrpPage = 1                                   ' 重新开始累计本组页数
    
63.         stGroupText = ctrGroup
    
64.     End If
    
65.     ainGrpPageTmp(inRptPage) = inGrpPage                ' 每个元素都储存页在组中的页码
    
66. End If
    
67. If MyRpt.Page = MyRpt.Pages Then
    
68. '报表已打开后重设纸张边距大小方向等会发生
    
69.     If inRptPage = MyRpt.Pages Then
    
70.     '仅在最后一页把临时数组中的页码信息更新到用于显示页码的数组
    
71.         For j = inRptPage - inGrpPage + 1 To inRptPage
    
72.             ainGrpPagesTmp(j) = inGrpPage               ' 这个循环代码与上面有重复，因为上面无法判断最后一页
    
73.         Next
    
74.         
    
75.         ReDim ainGrpPage(1 To inRptPage)                ' 数组大小为报表页数
    
76.         ReDim ainGrpPages(1 To inRptPage)
    
77.         For i = 1 To inRptPage
    
78.             ainGrpPage(i) = ainGrpPageTmp(i)
    
79.             ainGrpPages(i) = ainGrpPagesTmp(i)
    
80.         Next
    
81.     End If
    
82. End If
    
83. On Error Resume Next
    
84. If MyRpt.Pages > 0 Then
    
85.     inShowGrpPages = ainGrpPages(MyRpt.Page)   '
    
86.     inShowGrpPage = ainGrpPage(MyRpt.Page)    '
    
87.     If Not (lblShowPage Is Nothing) Then lblShowPage.Caption = _
    
88.         ctrGroup & ": " & inShowGrpPage & " / " & inShowGrpPages
    
89.     RaiseEvent Current(inShowGrpPage, inShowGrpPages)
    
90. End If
    
91. End Sub
    
92. Public Sub PrintPageFooter()
    
93. ' 区分两轮格式化
    
94.     blPrint = True
    
95. End Sub
    

复制代码

示例：

游客，如果您要查看本帖隐藏内容请回复

zyp

小宝,辛苦你了,谢谢!

asklove

经验之谈啊
先收藏！

jackysu78

谢谢分享

xuwenning

谢谢分享
楼主越来越厉害了

yanwei82123300

小宝,辛苦你了,谢谢!

ywfqd

look

Grant

小宝把这个漏洞给填补了,Good,收藏了谢谢

sxb2007

小宝,辛苦你了,谢谢!