一、需求

在利用word编写各种论文、报告以及招股书时，往往会需要插入一堆表格数据。由于数据更新频繁，每次更新报告，粘数就会让人非常疲惫。
因此如果能将excel里的数据映射到word文档中，每次数据更新时，word报告里的数据也可以同步更新，就十分方便。

二、实现原理

1. 建立excel数据与word 文档中表格之间的映射关系（链接）
2. 可以实现word文档中数据跟随excel数据同步更新功能

2.1 单文本操作演示

• 复制excel单元格数据，选择性粘贴为链接
• 更新excel单元格数据内容，查看word中数据同步更新

粘贴为链接.gif
更新数据.gif

2.2 表格数据操作演示

• 表格数据需选择性粘贴为富文本格式 (RTF) 或者html格式，这样word才识别为表格样式

• word里表格样式可以调整，只要不改变链接就可以

  
  链接表格数据.gif

2.3 映射关系查看

查看链接信息.gif

三、代码实现

3.1 初步实现

3.1.1 粘贴链接表

Sub paste_table_link()
'
' 建立EXCEL数据源与WORD报告之间的数据链接

Application.ScreenRefresh
With Selection
    .PasteExcelTable True, True, True '完成复制动作
End With

End Sub

官方文档：Selection.PasteExcelTable 方法 (Word) | Microsoft Docs

3.1.2 粘贴链接文本

Sub paste_text_link()
'
' 建立EXCEL数据源与WORD报告之间的数据链接

Application.ScreenRefresh
With Selection
    '完成复制动作
    .PasteSpecial Link:=True, DataType:=wdPasteText, Placement:= _
     wdInLine, DisplayAsIcon:=False     
End With

End Sub

官方文档：Selection.PasteSpecial 方法 (Word) | Microsoft Docs

3.2 进一步需求

由于报告往往需要cast数，且有定版的需求。因此有以下需求：

1. 设置数据自动更新为手动更新。
2. 每次更新后，已经更改的样式不变
3. 
   

   交付版本需要删除报告中所有的链接。

3.2.1 锁定链接单元格

1）粘贴表：

Sub paste_table_link()
'
' 建立EXCEL数据源与WORD报告之间的数据链接

Application.ScreenRefresh

With Selection
    .PasteExcelTable True, True, True '完成复制动作
End With

'数据设置为锁定
ActiveDocument.Fields.Locked = True

End Sub

2）粘贴数字

Sub paste_text_link()
'
' 建立EXCEL数据源与WORD报告之间的数据链接

Application.ScreenRefresh

With Selection
    '完成复制动作
    .PasteSpecial Link:=True, DataType:=wdPasteText, Placement:= _
     wdInLine, DisplayAsIcon:=False      
End With

'数据设置为锁定
ActiveDocument.Fields.Locked = True

End Sub

3.2.2 更新链接

1）更新所有链接

Sub update_link()

'更新word中所有的link
Application.ScreenRefresh
Dim f As Field
For Each f In ActiveDocument.Fields
f.Locked = False
f.Select
f.Update
f.Locked = True
Next f

End Sub

2）更新选中部分链接

Sub update_selection_link()
'更新选中区域的link
Dim f As Field
 For Each f In Selection.Range.Fields
 f.Locked = False
 f.Select
 f.Update
 f.Locked = True
 Next f

End Sub

3.2.3 删除链接

Sub break_link()

ActiveDocument.Fields.Unlink

End Sub

四、代码演示

vba执行演示.gif

---

五

代码：

Sub paste_table_link1()
'
' 建立EXCEL数据源与WORD报告之间的数据链接
' 1. 确保excel表格和word表格形式一致
' 2. 复制excel左上角第一个数据
' 3. 将光标放到word表格中对应的单元格中，点击宏按钮即可

Application.ScreenRefresh
On Error Resume Next
Set reg = CreateObject("vbscript.regexp")

With Selection
    table_C = .Information(wdMaximumNumberOfColumns)
    table_r = .Information(wdMaximumNumberOfRows)
    current_c = .Information(wdEndOfRangeColumnNumber) '或者这个table的信息和当期位置的信息
    current_r = .Information(wdEndOfRangeRowNumber)
    .PasteExcelTable True, True, True '完成复制动作
    .SelectCell
End With

Code = Selection.Fields(1).Code.Text  '先根据第一个贴过来的link获取excel的信息
MsgBox (Code)
reg.Pattern = "!R(\d+)C"
Set temp = reg.Execute(Code)
exl_rn = Val(temp(0).submatches.Item(0))
reg.Pattern = "!R\d+C(\d+)"
Set temp = reg.Execute(Code)
exl_cn = Val(temp(0).submatches.Item(0))


counter_i = 0
For i = current_c To table_C
    counter_j = 0
    For j = current_r To table_r
    new_code = Replace(Code, Replace("R" & exl_rn, " ", ""), Replace("R" & Str(exl_rn + counter_j), " ", ""))
    new_code = Replace(Replace(new_code, Replace("C" & exl_cn, " ", ""), Replace("C" & Str(exl_cn + counter_i), " ", "")), "\a", "")
    With Selection
    .Tables(1).Cell(j, i).Select
    .Delete
    .Collapse Direction:=wdCollapseStart
    .Range.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:=new_code
    End With
    counter_j = counter_j + 1
    Next j
    counter_i = counter_i + 1
Next i

ActiveDocument.Fields.Locked = True

End Sub

演示

vba执行演示.gif