如何生成传统世系表

付谦

作传统的世系报表,碰到在文本框内不能改变字体字号,无法随文字多少自动调整其宽度,故只能用代码给报表增加多个动态文本框,还要给其定位,设置字体字号,用数据表字段赋值,　一般五世一页,从右往左,按顺序同世同列,本人知识有限,,无法作出传统世系来,请高手帮忙,
要的效果见附件

aslxt

建议采用现代文档排版模式,大排序使用世次,小排序使用兄弟排行,这样比较简单,也符合现代人的阅读习惯,常规Word就可以胜任.
如果非要采用古谱式样,你可以研究一下Word的文字竖排,分栏.重点是如何截断相同世次的文字长度,不至于跨到下一栏.当然,还可以使用不限制页面尺寸的绘图软件(如visio,cad等),绘制完成后,再进行打印分页.
实际上,古谱的特点就是从右上角往下一世一栏,从右到左为同世次的兄弟,纸张无限大(与treeview类似,只是treeview是从左上到右下),然后根据需要进行裁剪装订而已.把古谱单页(上下为世次,右左为兄弟)平铺拼接后,确实很直观.

付谦

我原采用的是现代报表模式,,自动生成,省时省力.但都说没家谱味.后自己也觉得古谱式样有味些.只好边学习边求助大家了

aslxt

只能简单做成这样的了

付谦

感谢大师,请教一下是如何导出到WORD的,有无导出代码,?还是在WIRD一个一个手工调用形成的?

付谦

不断学习

aslxt

当然是代码,主要过程:1,打开word.application,新增document
2,设置document的文字为垂直,分成5栏(每页显示的从上到下的世代数量),其他使用默认值
3,按每代人一个document的方式导出为临时分表,当然要设置族人信息的不同部分的文字格式(加粗/字体/字号/双行合一...)
4,为document的每一栏的开始添加世代信息
5,重复1~4,顺序导出相邻的五代人为5个分表
6,新建document(5代人的总表),按照栏目/页/分表文件的方式循环,分别复制分表的一栏的文字到总表中粘贴,关闭分表   
7,调整5代人的总表的格式    ----以上已经完成.
8,重复i~7,顺序得出下一个相邻的五代人的总表,直至所有族人信息导出完成.
9,把各个五代人的总表,按照世代顺序,合并为一个document,完成.
还在改进中.如有兴趣,可加QQ:853156456

zpy2

付谦 发表于 2021-5-10 08:39
我原采用的是现代报表模式,,自动生成,省时省力.但都说没家谱味.后自己也觉得古谱式样有味些.只好边学习边求 ...

感觉用html也不错

付谦

用word作太复杂了，用ACCESS作简单多了，我是这样考虑的：
1.、在原数据表上增加行数、排行、分页、下页行四个字段，用程序按每页每世26行计算分别为其赋值。
2、ACCESS不支持在报表上添加动态控件，采用笨办法在每世页两边添加28个文本框,(一人3个，分别是关系、姓名、综合框,，并用字母&世代&排行命名)，还有一个文本框是为上页转下页行准备的，因每页只能容纳26行，姓名1人占2行，因此充其量每世只能9人，文本框宽设成线形，不然容不下，,高与上边距是固定的,，只有左边距与宽度在程度中动态设定.。采用复制,制作上百文本框也不费劲。
3、ASLXT大师此前的变量文本框语句使我的编程大大简化，经测试速度快省事，其他不细说,见程序
Private Sub 主体_Format(Cancel As Integer, FormatCount As Integer)
    Dim rs9 As New ADODB.Recordset
    Dim ssql9 As String
    Dim i9, FF, KK, EE, YY As Long
    Dim C9, MM As String
    Dim DD1, DD2 As String
    Dim NN, LB, LD, TF, TY, VY As Long
    Dim PP, LP As Integer
        i9 = 1
        ssql9 = "select * from 谱树临时表 where 分页=1 OR 下页行>0 ORDER BY 世代,排行 "      ''OR 下页行>0
        rs9.Open ssql9, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
           NN = 8634 '每世排行一姓名左边框,单位为缇
           LP = 1530
           TY = 0
       For i9 = 1 To CLng(rs9.RecordCount)
          FF = rs9!排行
          MM = rs9!综合
          TF = rs9!行数
          LD = rs9!下页行
           If rs9!世代 <= 6 Then
               EE = rs9!世代
           Else
                EE = IIf(rs9!世代 Mod 5 = 0, 5, rs9!世代 Mod 5)
           End If
            If rs9!关系 Like "之[妣,配,子,女]" Then
                DD1 = "　" & Right(rs9!关系, 1)
            ElseIf rs9!关系 Like "*[妣,配]" Then
                 DD1 = rs9!关系
                 LB = 0
            Else
                DD1 = Right(rs9!承上人, 2) & rs9!关系
                  LB = 70
            End If
            If Len(rs9!姓名) = 1 Then
               DD2 = "　" & Right(rs9!姓名, 1)
            Else
                DD2 = Right(rs9!姓名, 2)
            End If
                       KK = EE & FF        ''世代与排行
          If EE < 6 And FF < 10 Then
             If FF = 0 Then
               PP = LD
                 Me.Controls("textT" & EE & 0).Left = NN - LD * 327 + LP
                  Me.Controls("textT" & EE & 0).Width = LD * 327
              If TF = LD Then
                    If TF - LD = 0 Then Me.Controls("textT" & EE & 0) = MM
               Else
                    If TF - LD > 0 Then Me.Controls("textT" & EE & 0) = Mid(MM, (TF - LD) * 8, 150)
              End If
            End If
             PP = 0
          If FF > 0 Then
            Me.Controls("textU" & KK).Width = 576
              Me.Controls("textP" & KK).Width = 654
             Me.Controls("textT" & KK).Width = TF * 327   ''每行宽326缇
                  If FF = 1 Then
                          TY = 0
                          VY = FF * 2
                      Me.Controls("textP" & KK).Left = NN - (VY + PP) * 327 + LP - 5
                       Me.Controls("textU" & KK).Left = NN - (VY + PP) * 327 + LP + 40
                     Me.Controls("textT" & KK).Left = NN - (TF + VY + PP) * 327 + LP
                           TY = TF
                Else
                    Me.Controls("textP" & KK).Left = NN - (TY + PP + FF * 2) * 327 + LP
                    Me.Controls("textU" & KK).Left = NN - (TY + PP + FF * 2) * 327 + LP + LB
                          TY = TY + TF
                      If LD > 0 Then
                            If LD = TF Then
                                 Me.Controls("textT" & KK).Width = 0
                                 Me.Controls("textT" & KK).Left = NN - (TY + PP + FF * 2 - TF) * 327 + LP
                           Else
                                 Me.Controls("textT" & KK).Width = (TF - LD) * 327
                                 Me.Controls("textT" & KK).Left = NN - (TY + PP + FF * 2 - LD) * 327 + LP
                           End If
                     Else
                         Me.Controls("textT" & KK).Left = NN - (TY + PP + FF * 2) * 327 + LP
                     End If
                  End If
                      Me.Controls("textT" & KK) = Mid(MM, 1, (TF - LD) * 8)
                      Me.Controls("textU" & KK) = DD1
                      Me.Controls("textP" & KK) = DD2
          End If
          End If
                   rs9.MoveNext
      Next
              rs9.Close
              Set rs9 = Nothing
End Sub

付谦

If rs9!世代 <= 6 Then　　应是　If rs9!世代 <=5 Then