在不使用书签的情况下将命名范围从 excel 复制到 word 文档中的特定位置 [更新]

Question

我需要一些帮助来解决以下问题

作为示例，我在 excel 中有一系列范围。

表键	表范围
表6	A4:G14
表7	A15:G20
表8	A21:E30

等等。

我想知道是否有代码可以在我拥有的 word 文档中搜索第 1 列中的名称并将范围粘贴到第二列中。 这是我拥有的代码段

    For Each cell In rng "rng is the range of the table key column"
    If cell.Value = "" Then Exit For
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = False
        .Wrap = wdFindContinue
        .Text = cell.Value
        .Replacement.Text = Range(cell.Offset(0, 1))
        .Execute Replace:=wdReplaceAll
    End With
Next

我在 replacement.text 行中收到错误，但我不知道如何用范围替换它。

编辑我还尝试使用下面的代码复制和粘贴表中的范围，但我在 pasteexceltable 行中收到 object 定义的错误。

Set appWd = CreateObject("Word.Application")
set wdFind = appWd.Selection.Find
For Each cell In rng
    If cell.Value = "" Then Exit For
    ClipT = " "
    Range(cell.Offset(0, 1)).Copy
    wdFind.Text = cell.Value
    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd 'This function checks if the clipboard is empty'
    Range(cell.Offset(0, 1)).Copy
    ActiveWindow.Selection.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=True
    CutCopyMode = False

Answer 1

例如，如果您的 Word 模板包含相关表格，并且每个表格都使用与 Excel 中的表格名称相同的名称作为书签，则提供每个 Word 表格：

• 同时具有 header 行和空数据行； 和

• 与您的 Excel 数据相同的列数，

你可以使用如下代码：

Sub ExportToWord()
' Note: A reference to the Microsoft Word # Object Library is required,
' set via Tools|References in the Excel VBE.
Dim WdApp As New Word.Application, WdDoc As Word.Document
Dim XlSht As Excel.Worksheet, XlTbl As Excel.ListObject
Set XlSht = ThisWorkbook.Worksheets("Sheet1")
With WdApp
  Set WdDoc = .Documents.Add(Template:="full name & path to template")
  For Each XlTbl In XlSht.ListObjects
    XlTbl.DataBodyRange.Copy
    With WdDoc
      If .Bookmarks.Exists(XlTbl.Name) Then
        With .Bookmarks.Exists(XlTbl.Name)
          .Range.PasteAppendTable
          .Rows(2).Delete
        End With
      End If
    End With
  Next
End With
End Sub

Word 表最初具有空数据行的原因是粘贴不会采用 header 行的格式。

如果您真的，真的不想使用书签，您将需要另一种方法来关联 Word 表和 Excel 数据（例如，通过查找识别字符串 [例如 Excel 表的名称] 在 Word 中，或通过 Word 表index # [可能从 Excel 表的名称中检索到]）。

例如，如果 Excel 表的名称在 Word 表的第二行：

Sub ExportToWord()
' Note: A reference to the Microsoft Word # Object Library is required,
' set via Tools|References in the Excel VBE.
Dim WdApp As New Word.Application, WdDoc As Word.Document
Dim XlSht As Excel.Worksheet, XlTbl As Excel.ListObject
Set XlSht = ThisWorkbook.Worksheets("Sheet1")
With WdApp
  Set WdDoc = .Documents.Add(Template:="full name & path to template")
  For Each XlTbl In XlSht.ListObjects
    XlTbl.DataBodyRange.Copy
    With WdDoc
      With .Range.
        With .Find
          .Text = XlTbl.Name
          .MatchWildcards = True
          .Execute
        End With
        If .Find.Found = True Then
          With .Tables(1)
            .Range.PasteAppendTable
            .Rows(2).Delete
          End With
        End If
      End With
    End With
  Next
End With
End Sub

或者，如果 Word 表的索引 # 对应于 Excel 表的名称：

Sub ExportToWord()
' Note: A reference to the Microsoft Word # Object Library is required,
' set via Tools|References in the Excel VBE.
Dim WdApp As New Word.Application, WdDoc As Word.Document
Dim XlSht As Excel.Worksheet, XlTbl As Excel.ListObject
Set XlSht = ThisWorkbook.Worksheets("Sheet1")
With WdApp
  Set WdDoc = .Documents.Add(Template:="full name & path to template")
  For Each XlTbl In XlSht.ListObjects
    XlTbl.DataBodyRange.Copy
    With WdDoc
        With .Tables(Replace(XlTbl.Name, "Table", ""))
          .Range.PasteAppendTable
          .Rows(2).Delete
        End With
      End If
    End With
  Next
End With
End Sub