报表分组页码终极解决方案 - Office中国论坛/Access中国论坛

Option Compare Database
Option Explicit
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
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

复制代码