能否用邮件合并的方式解决按户分页生成文档

萍聚2019 · 发表于 2019-7-19 22:45

各位老师，EXCEL有村里的户口（家庭成员人数不定）信息，每个家庭成员的户编码是一样的，WORD有按户（包含家庭成员）分页登记的表格能否用邮件合并的方式生成文档！
感谢！

小花鹿 · 发表于 2019-7-30 11:00

这个应该不行，邮件合并是由模板而生成多页文档，但已经有多个文档，然后往里面写信息，不能用邮件合并

413191246se · 发表于 2019-7-30 12:36

不能用邮件合并，还可以试试 VBA。楼主请提供一份模拟文档，说明要达成的目标。

萍聚2019 · 发表于 2019-7-30 15:43

谢谢亲！已上传

萍聚2019 · 发表于 2019-7-30 15:50

413191246se 发表于 2019-7-30 12:36
不能用邮件合并，还可以试试 VBA。楼主请提供一份模拟文档，说明要达成的目标。

谢谢亲，已上传

413191246se · 发表于 2019-7-30 23:26

* 楼主，你好！——我边想算法边写代码，觉得问题不大。但是，我觉得你给的资料不是最真实的资料（当然不必给人员真实姓名；另外，“户主”是不是必须在每户的最上边一行呢？你给的资料不是这样），但表格得是真实表格。有限于此，我也不再编码，先停工，看看你是否再给更真实的表格，再继续编。

* 还有，我编码、算法思路也比较慢，因为水平低嘛，所以，如果楼主觉得太慢，可以等待本坛高手、大神；如果不在乎时间，可以等待，就等我的代码。

* 下面是试用代码：（代码注释部分请认真关注一下！）

Sub 户编码()
'请将 Excel 表格复制到新建 Word 文档中，并保存为同一文件夹下的 Word 文档，文件名为“户编码”
'请将 Word 文档“表一”改名为“调查表”，并同时打开“调查表”和“户编码”两个 Word 文档
Dim dcb As Document, hbm As Document
Dim m&, i&
Set dcb = Documents("调查表.docx")
Set hbm = Documents("户编码.docx")
'户编码--数据整理
hbm.Activate
If ActiveDocument.Tables.Count <> 1 Then MsgBox "户编码文档仅允许有一个表格！", 0 + 16: End
ActiveDocument.Tables(1).Rows(1).Delete
i = 1
With ActiveDocument
Do
With .Tables(i)
Do
m = m + 1
.Cell(m, 1).Select
If m = Selection.Tables(1).Range.Information(wdMaximumNumberOfRows) Then GoTo sk
If .Cell(m + 1, 1).Range.Text = .Cell(m, 1).Range.Text Then
Else
.Cell(m + 1, 1).Select
Selection.SplitTable
Exit Do
End If
Loop
i = i + 1
m = 0
End With
Loop
End With
sk:
End Sub
Sub 调查表()
'主文档----整理
' dcb.Activate
' MsgBox ActiveDocument.Tables.Count
Dim s&
Dim j&
Dim k&
s = Documents("户编码").Tables(1).Rows.Count
' MsgBox "拆分次数 s=" & s
With ActiveDocument.Tables(1).Range
.Cells(2).Select
Selection.SplitTable
End With
j = 1
Do
j = j + 1
With ActiveDocument.Tables(j).Range
.Cells(32).Select
Selection.SplitTable
End With
Loop Until j = s + 1
'循环赋值
j = 1
Do
j = j + 1
k = k + 1
ActiveDocument.Tables(j).Range.Cells(3).Range.Text = Documents("户编码").Tables(1).Cell(k, 2).Range.Text
ActiveDocument.Tables(j).Range.Cells(5).Range.Text = Documents("户编码").Tables(1).Cell(k, 3).Range.Text
Loop Until j = s
End Sub

复制代码

413191246se · 发表于 2019-7-31 00:02

* 楼主，我提个建议：请重新上传附件，要求是：“户编码”文档，必须是全部真实数据（但人名、电话号码、身份证信息请给变通一下）；“调查表”文档，请在所有要填的位置上填上数据，并标上红色（户主所在的整行数据请全部填充），比如要填 30 项，结果只给我 20 项，另外 10 项位置的数据楼主难道想自己处理吗？所以，要给我真实数据，一次完成。

萍聚2019 · 发表于 2019-12-5 14:32

413191246se 发表于 2019-7-31 00:02
* 楼主，我提个建议：请重新上传附件，要求是：“户编码”文档，必须是全部真实数据（但人名、电话号码、身 ...

谢谢亲，最近没有上线，才看到，不好意思呀

萍聚2019 · 发表于 2019-12-5 14:49

413191246se 发表于 2019-7-30 23:26
* 楼主，你好！——我边想算法边写代码，觉得问题不大。但是，我觉得你给的资料不是最真实的资料（当然不必 ...

只导入EXCEL表中的项，其他不是必填项，每一家的户主在第一行

萍聚2019 · 发表于 2019-12-5 14:50

萍聚2019 发表于 2019-12-5 14:49
只导入EXCEL表中的项，其他不是必填项，每一家的户主在第一行

如果再需要详细的资料，我晚上再传一份

		自动登录	找回密码
密码			免费注册