如何将EXCEL中的家庭成员信息自动填入WORD文档中？

huanger999 · 发表于 2014-4-13 17:46

本帖最后由 huanger999 于 2014-4-13 17:51 编辑

需要确认一下，是否已经按照你提供的示例那样，排序好了。每家第一个是户主，然后是这家的其他人员。然后是下一家。如果是，可以用VBA来做，规律性还是比较好的。
另外需要用替代的方式处理一下地址栏，例如“区”替代为“区@”，乡为“乡@”类似的，也就是说地址需要半人工的方式进行处理，仅需要处理户主的就可以了。另外，是否需要用红色字突出显示，我个人认为是不需要的。

huanger999 · 发表于 2014-4-13 21:49

本帖最后由 huanger999 于 2014-4-13 21:57 编辑

Sub getnew()
Application.ScreenUpdating = False
Dim mytable, myFirstRow As Range
Dim strHuzhu As String
Dim strZhuzhi As String
'For i = 3 To 10000
'If a Then Exit For
'Next
'定义excel对象
Dim AppExcel As Excel.Application, Wk As Excel.Workbook, Wksh As Excel.Worksheet
'打开Excel文件
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False '单选择
.Filters.Clear '清除文件过滤器
.Filters.Add "Excel Files", "*.xls;*.xlw;*.xlsx"
.Filters.Add "All Files", "*.*" '设置两个文件过滤器
If .Show = -1 Then
'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果您按 OK）和 0（如果您按 Cancel）。
myfilepath = .SelectedItems(1)
Else
Exit Sub
End If
End With
Set AppExcel = CreateObject("Excel.Application")
Set Wk = AppExcel.Workbooks.Open(myfilepath)
Set Wksh = Wk.sheets(1)
For i = 3 To 1000 '暂时按照Excel文件有1000条数据，如果超过，就修改为数据条数
If Wksh.Range("I" & i).Text = "" Then Exit For
If Wksh.Range("I" & i).Text = "户主" Then
'读取户主信息和住址信息
strHuzhu = Wksh.Range("B" & i).Text
strZhuzhi = Wksh.Range("J" & i).Text
strAddress = Split(strZhuzhi, "@")
'将模板表复制到最后
ActiveDocument.Tables(1).Range.Copy
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatOriginalFormatting)
'替换表头信息，包括户主姓名和住址
Set mytable = ActiveDocument.Tables(ActiveDocument.Tables.Count).Range
mytable.Tables(1).Cell(1, 1).Range.Find.Execute findtext:="《户主姓名》", replacewith:=strHuzhu, Replace:=1
mytable.Tables(1).Cell(1, 1).Range.Find.Execute findtext:="《乡镇》", replacewith:=strAddress(1), Replace:=1
mytable.Tables(1).Cell(1, 1).Range.Find.Execute findtext:="《村名》", replacewith:=strAddress(2), Replace:=1
mytable.Tables(1).Cell(1, 1).Range.Find.Execute findtext:="《村民小组》", replacewith:=strAddress(3), Replace:=1
mytable.Tables(1).Cell(1, 1).Range.Find.Execute findtext:="《门牌》", replacewith:=Replace(strAddress(4), "号", ""), Replace:=1
myRow = 3 '新的表格从第三行开始填写人口信息
End If
'如果某户人数超过7人，开始增加行，这样无论某户多少人口，最后总有一个空行
If myRow > 7 Then
mytable.Tables(1).Cell(myRow - 1, 2).Range.Select
Selection.InsertRowsBelow 1
End If
'填写人口信息数据
mytable.Tables(1).Cell(myRow, 2).Range = Wksh.Range("B" & i)
mytable.Tables(1).Cell(myRow, 3).Range = Wksh.Range("D" & i)
mytable.Tables(1).Cell(myRow, 4).Range = Wksh.Range("I" & i)
mytable.Tables(1).Cell(myRow, 6).Range = Wksh.Range("E" & i)
mytable.Tables(1).Cell(myRow, 8).Range = Wksh.Range("F" & i)
mytable.Tables(1).Cell(myRow, 10).Range = strAddress(0)
'行数加1
myRow = myRow + 1
Next
'退出excel文件
AppExcel.Quit
Set Wksh = Nothing
Set Wk = Nothing
Set AppExcel = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

huanger999 · 发表于 2014-4-13 22:02

1、需要处理excel文件的住址列，完成效果参考附件xls文件。方法见11楼。xls文件处理完之后，请关闭。
2、需要运行宏getnew。（楼主如果没有运行过宏，请先设置宏安全性，网络查找相关内容，或者站内查找。）
3、会弹出文件对话框，指定excel文件的位置。
4、会得到如附件doc的结果。宏在附件的doc文件中。

会辉哥 · 发表于 2016-2-24 10:11

huanger999 发表于 2014-4-13 22:02
1、需要处理excel文件的住址列，完成效果参考附件xls文件。方法见11楼。xls文件处理完之后，请关闭。
2、 ...

很期待。。。希望老师能指导我一下。。。我的QQ 184824493

csx128 · 发表于 2016-3-4 20:15

这个实例很实用，学习了！！！

praijna · 发表于 2019-9-1 09:23

学习了，感恩各位的分享！

GONG2816 · 发表于 2019-11-11 12:05

不知为何，12楼的代码运行至下面这个位置时，会出现“用户定义的类型未定义”的错误揭示，请高手指点。
Dim AppExcel As Excel.Application, Wk As Excel.Workbook, Wksh As Excel.Worksheet

daibao88 · 发表于 2019-11-11 16:39

GONG2816 发表于 2019-11-11 12:05
不知为何，12楼的代码运行至下面这个位置时，会出现“用户定义的类型未定义”的错误揭示，请高手指点。
Di ...

引用MICROSOFT EXCEL X.0 OBJECT LIBRARY x为excel版本号

474091335 · 发表于 2019-11-20 12:19

楼主解决了吗，我现在也是遇到这种繁琐的复制粘贴问题

474091335 · 发表于 2019-11-20 12:21

求解我也是这样的

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