|
问题完全解决
Private Sub Command29_Click()
CurrentDb.Execute "UPDATE 报表数据源表 SET 报表数据源表.印页 = 0;"
Dim i, i3 As Integer
Dim n As Integer
Dim Intsz() As Integer
Dim strsql As String
Dim rst As Object
Dim ww, qq, 组别 As Long
nh = 6 '世代数,
qq = nh '世代数变量,提高通用性
strsql = "SELECT Max(报表数据源表.页) AS 页之最大值 FROM 报表数据源表 GROUP BY Partition([世代],1,100," & qq & " ) HAVING (((Partition([世代], 1, 100," & qq & " )) <> False)) ORDER BY Partition([世代],1,100," & qq & ");"
Set rst = CurrentDb.OpenRecordset(strsql)
rst.MoveLast
rst.MoveFirst
n = rst.RecordCount
ReDim Intsz(1 To n)
For i = 1 To n
Intsz(i) = rst("页之最大值") '给数组赋值
rst.MoveNext
Next i
Dim rs6 As New ADODB.Recordset
Dim I2 As Long
Dim ssql6 As String
Dim s, v, f As Integer
Dim x, 加组 As Integer
ssql6 = "select 世代,页,印页,转下页行 from 报表数据源表 ORDER BY 世代,页,页序 "
rs6.Open ssql6, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rs6.MoveFirst
加页 = 0
For I2 = 1 To CLng(rs6.RecordCount)
ww = rs6!世代
s = rs6!页
v = rs6!转下页行
f = Int((ww - 1) / qq) '分组
If f = 组别 Then '同组
rs6!印页 = s + sum
If f > 0 And s = Intsz(f + 1) And v > 0 Then
Intsz(f) = Intsz(f) + 1 '加页赋值给数组 '
Else
' Intsz(f) = Intsz(f) '不加页不变
End If
Else '下一组的第一条
sum = 0
组别 = Int((ww - 1) / qq)
For x = 1 To f
sum = sum + Intsz(x) '前面组累加数
Next
End If
rs6!印页 = s + sum
rs6.Update
rs6.MoveNext
Next I2
rst.Close
Set rst = Nothing
rs6.Close
Set rs6 = Nothing
End Sub |
|