使用 Word 宏/VBA 将表格从一个 Word 文档复制到另一个 Word 文档

Question

我是 VBA 的新手，我想寻求帮助以创建 Word 宏以将某些内容表从 Microsoft Office 365 Word 文档 A 复制到 Microsoft Office 365 Word 文档 B。

1. 文档 A 至少有 1 个内容表，但最多可以有 20 个内容表。 换句话说，上限是动态的。

1.1 每个内容表有两行四列：

1.1.1 第一行有四列单元格，

1.1.2 第二行将第一列和第二列单元格合并为一个单元格，因此第二行有三列。

2. 文档 B 是一个空白模板。 它有一些预定义的文本内容，然后是 20 个空白内容表。 文档 B 中的内容表结构与文档 A 中的内容表结构相同。

3. 宏需要执行以下操作：

3.1 以相同的顺序将内容表从文档 A 复制到文档 B。

3.2 文件A中各内容表，复制如下：

3.2.1 将第一行原样复制到文档B对应内容表的第一行。

3.2.2 复制第二行如下：

3.2.2.1 将文档A中第二行第一列/单元格复制到文档B中第二行第一列/单元格中。

3.2.2.2 将文档A中第二行第三列/单元格复制到文档B中第二行第二列/单元格中，仅此而已。

我试图录制一个宏来执行上述操作，但它不起作用。

请提供建议和帮助。

Answer 1

您（可能错误地）称为模板的文档 B 不是空白的 - 它有内容。 至于表复制，试试：

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, t As Long
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source file"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
  Else
    MsgBox "No source file selected. Exiting", vbExclamation
    GoTo ErrExit
  End If
End With
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the target file"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocTgt = Documents.Open(.SelectedItems(1), ReadOnly:=False, AddToRecentFiles:=False)
  Else
    MsgBox "No target file selected. Exiting", vbExclamation
    DocSrc.Close SaveChanges:=False
    GoTo ErrExit
  End If
End With
With DocSrc
  For t = 1 To .Tables.Count
    DocTgt.Tables(t).Range.FormattedText = .Tables(t).Range.FormattedText
    DocTgt.Tables(t).Cell(2, 3).Range.Text = vbNullString
    DocTgt.Tables(t).Cell(2, 4).Range.Text = vbNullString
  Next
  .Close False
End With
DocTgt.Activate
ErrExit:
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub