实现此功能代码怎么写?

付谦

   想用代码完成以下工作:
1、对各世的记录进行分页和按页排序
2、同一世按26行(行数+姓名占用2行)为一页，并赋于页号,同一页从1开始排页序
3、有时出现某页超出26行,超出行赋转下页行，如果出现25行(PP=25)时，本页不再增加人，如PP=24,还可增加1人，超出行见前处理
4、转下页行计入下页的26行内
附件表内的总行、页值、页序值、转下页行值仅供编程时参考用,。
本人作不出来,请高手帮忙,谢谢!!!

付谦

急用!请高手帮助修改
　要的效果
  '对各世的记录进行分页和按页排序
    '同一世按26行(行数+姓名占用2行)为一页,并赋于页号页,同世同页从1开始排页序
    '有时出现某页超出26行,超出行赋转下页行,因姓名要占2行,如果出现25行(PP=25)时,虽本页少1行也不再增加人,如PP=24,还可增加1人,超出行见前处理
    '转下页行计入下页的26行内
   
    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

姓名和他下面的行数可以分开?还是必须保持在一页?

张三
字号别名,功名传赞,生居殁葬,妻妾子嗣. ...

付谦

aslxt 发表于 2021-6-1 10:17
姓名和他下面的行数可以分开?还是必须保持在一页?

张三

ASLXT大师:
　　表综合字段包括了个人的字号别名,功名传赞,生居殁葬,妻妾子嗣. ...等信息,行数是由综合字段字数除8(报表每行8个字)得到的.这次给每个人定位,即何页,左右,本页的行和下页的行.为何每页定为26行,因为每世每页最多只能容纳26行,姓名字较大占2行,这次要的页就是打印在何页上,页序此人在本世本页的第几个,有时出现此人在此页打不下所有行,转到下页去打印,报表已经做好,只少这次代码统计的定位信息了

aslxt

大致是这样,你测试一下:
    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

网页又不让编辑回复了,改正一下:
    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

付谦

ASLXT大师:
　　我做了一星期未成，正无望时，您给我解决了问题，万分感谢！

付谦

aslxt 发表于 2021-6-1 17:21
网页又不让编辑回复了,改正一下:
    Dim rs2 As New ADODB.Recordset
    Dim ssql2 As String

各位大师
     我在ASLXT大师原码基础上,给表增加了行计字段，增加了计算代码。在使用中存在二个问题：一是第一条记录的转下页行不增加到第二条记录的行计中，其他记录增加,并是正确的。二是有时出现转下页行超过26行，需要添加一页，同时还会出现转下页行的问题，这如何处理，我添加的代码不理想,如何改写才正确，请帮助.

GOODWIN

学习学习