Dim rs2 As New ADODB.Recordset
CurrentDb.Execute "UPDATE 表 SET 页 = 0, 转下页行 = 0, 页序 = 0;" ''初始
Dim ssql2 As String
Dim A, B, C, D As Long
Dim PP, X, Y As Integer
i2 = 1
ssql2 = "select * from 表 ORDER BY 世代,族人代码 "
rs2.Open ssql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
A = rs2!页
B = rs2!页序
C = rs2!转下页行
X = rs2!世代
Y = rs2!行数
For i2 = 1 To CLng(rs2.RecordCount)
'' If X > 0 Then
If PP <= 28 Then
A = 1
B = B + 1
PP = PP + Y + 2
If PP > 26 Then C = PP - 26 '超过26行的记入下页行
Else
'' B = 0
B = B + 1
'' A = 1
A = A + 1
'' PP = PP + Y + 2
'' If PP > 26 Then C = PP - 26
End If
rs2!页 = A
rs2!页序 = B
rs2!转下页行 = C
rs2.Update
rs2.MoveNext
Next
rs2.Close
Set rs2 = Nothing
End Sub 作者: aslxt 时间: 2021-6-1 10:17
姓名和他下面的行数可以分开?还是必须保持在一页?
ASLXT大师:
表综合字段包括了个人的字号别名,功名传赞,生居殁葬,妻妾子嗣. ...等信息,行数是由综合字段字数除8(报表每行8个字)得到的.这次给每个人定位,即何页,左右,本页的行和下页的行.为何每页定为26行,因为每世每页最多只能容纳26行,姓名字较大占2行,这次要的页就是打印在何页上,页序此人在本世本页的第几个,有时出现此人在此页打不下所有行,转到下页去打印,报表已经做好,只少这次代码统计的定位信息了作者: aslxt 时间: 2021-6-1 16:45
大致是这样,你测试一下:
Dim rs2 As New ADODB.Recordset
Dim ssql2 As String
Dim 本页已用行数 As Long, 总页码 As Long, 页序 As Long, 转下页行数 As Long, 世代 As Long
Dim i As Long
CurrentProject.Connection.Execute "update 表 set 页=0,页序=0,转下页行=0"
ssql2 = "select * from 表 ORDER BY 世代,族人代码 "
rs2.Open ssql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'Debug.Print rs2.RecordCount
总页码 = 0
本页已用行数 = 0
页序 = 0
For i = 1 To rs2.RecordCount
If rs2!世代 = 世代 Then
'
If 本页已用行数 < 26 - 2 Then
'至少可以在本页插入姓名
页序 = 页序 + 1
rs2!页 = 总页码
rs2!页序 = 页序
If 本页已用行数 + 2 + rs2!行数 <= 26 Then
本页已用行数 = 本页已用行数 + 2 + rs2!行数
转下页行数 = 0
Debug.Print "a", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
Else
'综合跨页,不是姓名跨页
Debug.Print "b1", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
转下页行数 = 本页已用行数 + 2 + rs2!行数 - 26
'Debug.Print 总页码, Int(转下页行数 / 26)
总页码 = 总页码 + Int((本页已用行数 + 2 + rs2!行数) / 26)
本页已用行数 = 转下页行数 Mod 26
页序 = 0
Debug.Print "b2", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
End If
rs2!转下页行 = 转下页行数
' Debug.Print "a", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
Else
'跨页
总页码 = 总页码 + 1
本页已用行数 = 0
页序 = 1
rs2!页 = 总页码
rs2!页序 = 页序
If 2 + rs2!行数 <= 26 Then
本页已用行数 = 2 + rs2!行数
转下页行数 = 0
Debug.Print "c", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
Else
总页码 = 总页码 + Int((2 + rs2!行数) / 26)
转下页行数 = (2 + rs2!行数) Mod 26
Debug.Print "d", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
End If
rs2!转下页行 = 转下页行数
End If
Else
'新的一代,从新的页开始
总页码 = 总页码 + 1
本页已用行数 = 0
页序 = 1
rs2!页 = 总页码
rs2!页序 = 页序
If 2 + rs2!行数 <= 26 Then
本页已用行数 = 2 + rs2!行数
转下页行数 = 0
Debug.Print "e", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
Else
总页码 = 总页码 + Int(2 + rs2!行数)
转下页行数 = (2 + rs2!行数) Mod 26
Debug.Print "f", rs2!族人代码, 总页码, 页序, 本页已用行数, 转下页行数
End If
rs2!转下页行 = 转下页行数
End If
世代 = rs2!世代
rs2.Update
rs2.MoveNext
Next i
'Debug.Print "ok"
rs2.Close
Set rs2 = Nothing作者: aslxt 时间: 2021-6-1 17:21
网页又不让编辑回复了,改正一下:
Dim rs2 As New ADODB.Recordset
Dim ssql2 As String
Dim 本页已用行数 As Long, 总页码 As Long, 页序 As Long, 转下页行数 As Long, 世代 As Long
Dim i As Long
CurrentProject.Connection.Execute "update 表 set 页=0,页序=0,转下页行=0"
ssql2 = "select * from 表 ORDER BY 世代,族人代码 "
rs2.Open ssql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
总页码 = 0
本页已用行数 = 0
页序 = 0
For i = 1 To rs2.RecordCount
If rs2!世代 = 世代 Then
If 本页已用行数 <= 26 - 2 Then
'至少可以在本页插入姓名
页序 = 页序 + 1 '族人的页序逐个增加
rs2!页 = 总页码 '族人信息的开始页码不变
rs2!页序 = 页序
If 本页已用行数 + 2 + rs2!行数 <= 26 Then
'没有转页的情况
本页已用行数 = 本页已用行数 + 2 + rs2!行数 '追加本页已用的行数
转下页行数 = 0
Else
'综合跨页,不是姓名跨页,也不是世代跨页
转下页行数 = 本页已用行数 + 2 + rs2!行数 - 26
总页码 = 总页码 + Int((转下页行数) / 26) '记录族人信息的结束页码,也是下一个族人信息的开始页码
本页已用行数 = 转下页行数 Mod 26 '记录最后一页已经使用的行数
页序 = 0 '重置页序,使得下一个族人的页序变为第一个
End If
rs2!转下页行 = 转下页行数
Else
'跨页,开始新的族人信息
总页码 = 总页码 + 1
本页已用行数 = 0
页序 = 1
rs2!页 = 总页码
rs2!页序 = 页序
If 2 + rs2!行数 <= 26 Then
本页已用行数 = 2 + rs2!行数
转下页行数 = 0
Else
总页码 = 总页码 + Int((2 + rs2!行数) / 26)
转下页行数 = (2 + rs2!行数) Mod 26
End If
rs2!转下页行 = 转下页行数
End If
Else
'新的一个世代的族人,从新的页开始
总页码 = 1 ' 总页码 + 1
本页已用行数 = 0
页序 = 1
rs2!页 = 总页码
rs2!页序 = 页序
If 2 + rs2!行数 <= 26 Then
本页已用行数 = 2 + rs2!行数
转下页行数 = 0
Else
总页码 = 总页码 + Int((2 + rs2!行数) / 26)
转下页行数 = (2 + rs2!行数) Mod 26
End If
rs2!转下页行 = 转下页行数
End If
世代 = rs2!世代 '记录世代信息,便于下一代从新页开始
rs2.Update
rs2.MoveNext
Next i
'Debug.Print "ok"
rs2.Close
Set rs2 = Nothing作者: 付谦 时间: 2021-6-1 18:41 本帖最后由 付谦 于 2021-6-1 18:53 编辑