Question

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

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

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

1.1.1第一行有四个列单元格

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

文档B是空白模板。它具有一些预定义的文本内容，然后是20个空白内容表。文档B中的内容表结构与文档A中的内容表结构相同。
宏需要执行以下操作：

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

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

1 个答案: