Office中国论坛/Access中国论坛

标题: 如何生成传统世系表 [打印本页]

作者: 付谦 时间: 2021-5-9 15:59
标题: 如何生成传统世系表
本帖最后由付谦于 2021-5-9 16:02 编辑

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

作者: aslxt 时间: 2021-5-10 07:26
本帖最后由 aslxt 于 2021-5-10 08:38 编辑

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

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

作者: aslxt 时间: 2021-5-22 11:56
只能简单做成这样的了

作者: 付谦 时间: 2021-5-23 19:24
感谢大师,请教一下是如何导出到WORD的,有无导出代码,?还是在WIRD一个一个手工调用形成的?

作者: 付谦 时间: 2021-5-23 20:04
本帖最后由付谦于 2021-5-23 20:28 编辑

不断学习

作者: aslxt 时间: 2021-5-24 09:48
本帖最后由 aslxt 于 2021-5-24 10:45 编辑

当然是代码,主要过程: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-24 12:13

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

感觉用html也不错

作者: 付谦 时间: 2021-5-24 12:27
用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

作者: 付谦 时间: 2021-5-24 13:28
If rs9!世代 <= 6 Then　　应是　If rs9!世代 <=5 Then

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)