使用 VBA 代码将表格从 Excel 复制到 Word 书签答案

【问题标题】：Copying table from Excel to Word bookmark using VBA code使用 VBA 代码将表格从 Excel 复制到 Word 书签
【发布时间】：2018-04-27 12:20:08
【问题描述】：

我实际上需要您的帮助来修改此宏代码。我从其他地方得到了这个代码（对不起，忘记了他的名字！）。基本上，我有来自 Excel 的 Sheet1 的表格数据源。我需要使用名为“书签”的书签将这个表格转移到 MS Word 中，将边框、字体大小、自动调整等格式保持在 MS Word 中。注意事项：

书签的位置在最后一段。我的 Word 文件中有超过 12 个段落，但表格应该放在最后一段。
请注意，表数据源中的行数和列数是动态的。这意味着，行数和列数不是固定的。它可以改变。我现有的宏代码适用于此。但是，它完全删除了现有段落。该表替换了我文件中的所有内容。我不知道将此表放置到书签所在位置的确切宏代码。

感谢您对第 2 项的帮助。以下是代码：

Private Sub CommandButton1_Click()
On Error Resume Next

    ' FIRST GET THE ROWS COLUMNS OF A USED RANGE.

    Dim iTotalRows As Integer   ' GET TOTAL USED RANGE ROWS.
    iTotalRows = Worksheets("sheet1").UsedRange.Rows.Count


    Dim iTotalCols As Integer   ' GET TOTAL COLUMNS.
    iTotalCols = Worksheets("sheet1").UsedRange.Columns.Count



    ' WORD OBJECT.
    Dim oWord As Object
    Set oWord = CreateObject(Class:="Word.Application")
    oWord.Visible = True
    oWord.Activate

    ' ADD A DOCUMENT TO THE WORD OBJECT.
    Dim oDoc
    Set oDoc = oWord.Documents.Open("C:\Macro\samplebookmark1.docx")


    ' CREATE A RANGE FOR THE TABLE INSIDE WORD DOCUMENT.
    Dim oRange
    Set oRange = oDoc.Range


    ' CREATE AND  DEFINE TABLE STRUCTURE USING
        ' THE ROWS AND COLUMNS EXTRACTED FROM EXCEL USED RANGE.
    oDoc.Tables.Add oRange, iTotalRows, iTotalCols


    ' CREATE A TABLE OBJECT.
    Dim oTable
    Set oTable = oDoc.Tables(1)
    oTable.Borders.Enable = True      ' YES, WE WANT BORDERS.


    Dim iRows, iCols As Integer


    ' LOOP THROUGH EACH ROW AND COLUMN TO EXTRACT DATA IN EXCEL.
    For iRows = 1 To iTotalRows
        For iCols = 1 To iTotalCols
            Dim txt As Variant
            txt = Worksheets("Sheet1").Cells(iRows, iCols)
            oTable.cell(iRows, iCols).Range.Text = txt        ' COPY (OR WRITE) DATA TO THE TABLE.


            ' BOLD HEADERS.
            If Val(iRows) = 1 Then
                objTable.cell(iRows, iCols).Range.Font.Bold = True
            End If
        Next iCols
    Next iRows

    Set oWord = Nothing
End Sub

【问题讨论】：

标签： excel ms-word bookmarks vba

【解决方案1】：

问题出在这一行：

Set oRange = oDoc.Range

现在，它定义了整个文档范围而不是书签的范围。
你应该使用类似的东西：

Set oRange = oDoc.Bookmarks("BookmarkName").Range

关于您的新问题，解决它的一种方法是将表格直接放入文档的最后一段而不使用书签。

Set oRange = oDoc.Range.Paragraphs(oDoc.Range.Paragraphs.Count).Range

【讨论】：

非常感谢！你救了我的星期五！祝你有美好的一天！
您好，先生！我自己想通了！非常感谢你！我还有几个问题。我的 VBA 宏保持不变。 1.我只想复制粘贴表格范围，不包括嵌入返回空字符串的公式的单元格。使用我当前的代码，它确实包括。我怀疑是因为 itotalrows 和 itotalcolumns 中的这个“UsedRange”。请问我该如何编辑？ 2.另外，当我复制和粘贴格式的数据时，我在excel中的数字有逗号，但是当它使用邮件合并导出到我的word时，它没有逗号和.00了。我该如何修改我的宏？非常感谢您，先生！
@LadyTiara 您的代码中与邮件合并无关。

【解决方案2】：

由于“表格应该放在最后一段”，因此您不需要书签或任何复杂的范围设置。您只需要：

With oDoc
  Set oTable = .Tables.Add .Range.Characters.Last, iTotalRows, iTotalCols
End with

至于输出格式， , 而不是：

txt = Worksheets("Sheet1").Cells(iRows, iCols)
            oTable.cell(iRows, iCols).Range.Text = txt

使用：

oTable.cell(iRows, iCols).Range.Text = Worksheets("Sheet1").Cells(iRows, iCols).Text

在更基本的层面上，您为什么不简单地复制和粘贴 Excel 范围作为一个步骤，而不是通过复杂的表格创建和逐个单元格填充？

【讨论】：