根据word表格中企业名称黄底显示，从excel引用数据自动填充word中其它单元格（红字）

caaszrj

根据word表格中企业名称（黄底显示），从excel引用数据自动填充word中其它单元格（红字表示），请问域跟vba那个能实现，那个更为便捷？ wordexcel附件.rar (182.03 KB, 下载次数: 11)

2014-11-17 00:40 上传

点击文件名下载附件

caaszrj

谁能帮帮我啊？

413191246se

楼主，因为你的EXCEL我是2003的打不开，所以，我建议，如果EXCEL表格中是规范的（第一行）为字段名称的话，不妨用Word的“邮件合并”功能来合并即可，而不必用VBA；用VBA也可以，但稍费点时间。——如果楼主提供一下 2003 格式的 EXCEL 表格，我可以试试 FOR YOU。

caaszrj

413191246se 发表于 2014-11-20 10:35
楼主，因为你的EXCEL我是2003的打不开，所以，我建议，如果EXCEL表格中是规范的（第一行）为字段名称的话， ...

根据word表格中企业名称黄底显示，从excel引用数据自动填充word中其它单元格（红字）.rar (319.21 KB, 下载次数: 10)

2014-11-20 20:16 上传

点击文件名下载附件

我试过邮件合并了，合并生成的word文档，没有与excel工作表链接，我在excel中更改数据的话，word中的数据没法同步更新，所以还得麻烦您了，老兄！

pipiludaxian

找个配置高些的电脑，速度也可以。运行前，请讲第一段的下划线删除，变为开发企业情况

Sub test001()
Dim MyXL As Object
Dim i As Integer
On Error Resume Next
ActiveDocument.Content.Copy
For n = 1 To 10 '请将10改为你需要的表格数量
ActiveDocument.ActiveWindow.ActivePane.Pages(n).Rectangles(1).Range.Paste
Next
Application.ScreenUpdating = False
Set MyXL = GetObject("C:\Documents and Settings\Administrator\桌面\根据word表格中企业名称\kkk.xls")  '请改成自己的文件名
MyXL.Application.Visible = False
For i = 3 To 13
    mystr = MyXL.sheets(1).Cells(i, 2)
    With ActiveDocument.ActiveWindow.ActivePane.Pages(i - 2).Rectangles(1).Range
        .Paragraphs(1).Range.Characters(3).Select
            With Selection
                .Collapse wdCollapseEnd
                .InsertAfter mystr
                .font.Underline = wdUnderlineSingle
            End With
        .Tables(1).Cell(1, 2).Range.Text = MyXL.sheets(1).Cells(i, 2)
        .Tables(1).Cell(1, 4).Range.Text = MyXL.sheets(1).Cells(i, 3)
    End With
Next
Set MyXL = Nothing
Application.ScreenUpdating = True
End Sub

pipiludaxian

.Tables(1).Cell(1, 2).Range.Text = MyXL.sheets(1).Cells(i, 2)
.Tables(1).Cell(1, 4).Range.Text = MyXL.sheets(1).Cells(i, 3)
之后，请按照excel表格与word表格的对应关系，继续添加语句。
我就不再挨个写了。

413191246se

楼主，如果想保持WORD和EXCEL数据链接，我恐怕没有好办法，只能建议你用默认的数据嵌入了（如果不保持链接，用VBA倒是可以）。

caaszrj

pipiludaxian 发表于 2014-11-20 23:54
.Tables(1).Cell(1, 2).Range.Text = MyXL.sheets(1).Cells(i, 2)
.Tables(1).Cell(1, 4).Range.Text = My ...

谢谢你了，朋友，让你费心了。