Question

我实际上需要你帮助修改这个宏代码。我从其他地方得到了这个代码（对不起，忘记了他的名字！）。基本上，我有来自Excel的Sheet1的表数据源。我需要传输这个表，保持格式如边框，字体大小，自动调整等，使用我的书签“书签”保存到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

Answer 1

问题在于这一行：

Set oRange = oDoc.Range

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

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

<小时/> 关于你的新问题，解决这个问题的一种方法是将表格直接放入文档的最后一段而不使用书签。

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

Answer 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范围复制并粘贴为一个步骤，而不是进行复杂的表创建和逐个单元填充？

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

2 个答案: