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

问题描述：

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

I am new to VBA and I would like seek help to create a Word macro to copy certain content tables from Microsoft Office 365 Word Document A to Microsoft Office 365 Word Document B.

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

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

1.1 Each content table has two rows and four columns:

1.1.1 第一行有四列单元格，

1.1.1 the first row has four column cells,

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

1.1.2 the second row has the first and second column cells merged into one cell, and thus the second row has three columns.

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

Document B is a blank template. It has some pre-defined text content and then followed by 20 blank content tables. The content table structure in Document B is the same as that in Document A.

宏需要执行以下操作:

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

3.1 Copy the content tables from Document A to Document B in the same sequential order.

3.2 对文档 A 中的每个内容表，复制如下:

3.2 For each content table in Document A, copy as below:

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

3.2.1 Copy the first row as is to the first row of the corresponding content table in Document B.

3.2.2 复制第二行如下:

3.2.2 Copy the second row as below:

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

3.2.2.1 Copy the second row’s first column/cell in Document A to the second row’s first column/cell in Document B.

3.2.2.2 将文档 A 中第二行的第三列/单元格复制到文档 B 中第二行的第二列/单元格.就这样.

3.2.2.2 Copy the second row’s third column/cell in Document A to the second row’s second column/cell in Document B. That’s all.

我尝试录制一个宏来执行上述操作，但没有奏效.

I tried to record a macro to do the above but it did not work.

请多多指教和帮助.

答

您(可能错误地)将其称为模板的文档 B 不是空白的 - 它有内容.至于表复制，试试:

Your Document B, which you (probably erroneously) call a template is not blank - it has content. As for the table replication, try:

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 文档

相关推荐