Question

请帮助！我是新来的！我想将表格从表格“ Table1”从excel转移到现有Word中的Bookmark1（模板fisa de esantionare var.4.docx）。

此宏的问题在于表已转移到word，但它会擦除word中的所有信息。并且该表未出现在指定的Bookmark1位置。谢谢。

我试图修改Macro（宏）行，但这不起作用。

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

    with:
    Dim oRange
    Set oRange = oDoc.Bookmark("Bookmark1")

    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("Table1").UsedRange.Rows.Count


Dim iTotalCols As Integer   ' GET TOTAL COLUMNS.
iTotalCols = Worksheets("Table1").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:\Users\stefan.georgescu\Desktop\Template fisa de esantionare var.4.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("Table1").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

将文档添加到单词对象之后。

您有：

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

您需要：

' CREATE A RANGE FOR THE TABLE INSIDE WORD DOCUMENT.
Dim oRange
Set oRange = oDoc.Bookmarks("Bookmark1").Range

Answer 2

问题中显示的代码存在许多问题-由于On Error Resume Next，这些问题可能并不明显。应该将其注释掉，尤其是在测试阶段。该命令将忽略错误，因此不会告诉您什么时候不起作用，更重要的是，不会有任何信息说明为什么为什么不是预期的结果。我在下面的示例代码中对此行进行了注释。

我试图尽可能地保持不变，但是我确实以更合乎逻辑的顺序移动了一些声明和实例化。

尽管它不是在代码的开头，但是由于问题是关于将目标范围设置为书签位置，因此可以如下进行操作。请注意，书签名称应使用引号引起来。根据书签的类型（是否标记点或包含内容），书签可能会被删除。（带有内容的书签会被删除，内容也会被删除；“点书签”将保留，但将不包含表。）如果应保留书签或应包含表，则可以使用扩展代码进行更改。

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

请注意，通常最好在创建对象时实例化（“设置”）对象，而不是事后进行实例化。例如，

Set oDoc = oWord.Documents.Open
Set oTable = oDoc.Tables.Add

由于仅第一行将以粗体显示，因此无需在循环中检查它是否是第一行，然后再以粗体显示-每个“ If”都花费时间/资源。因此，我将该命令移出了循环，删除了If并添加了正确的变量名（oTable，而不是objTable，该变量名在任何地方都没有声明）。

完成在另一个应用程序中使用对象的过程（如Excel中的Word对象）时，释放 all 对象，而不仅仅是应用程序很重要。并且应该以与创建它们相反的顺序进行。我在末尾的Set行中添加了其他Nothing。

请注意，由于没有Excel数据，因此无法测试此过程，因此可能会有小的语法错误。

Sub TableFromXlToWd()
'    On Error Resume Next

    ' FIRST GET THE ROWS COLUMNS OF A USED RANGE.

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

    Dim iTotalCols As Integer   ' GET TOTAL COLUMNS.
    iTotalCols = Worksheets("Table1").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 As Object  'Word.Document
    Set oDoc = oWord.Documents.Open("C:\Users\stefan.georgescu\Desktop\Template fisa de esantionare var.4.docx")       

     ' CREATE A RANGE FOR THE TABLE INSIDE WORD DOCUMENT.
    Dim oRange As Object 'Word.Range
    Set oRange = oDoc.Bookmarks("Bookmark1").Range

    ' CREATE AND  DEFINE TABLE STRUCTURE USING
        ' THE ROWS AND COLUMNS EXTRACTED FROM EXCEL USED RANGE.
    Dim oTable As Object 'Word.Table
    Set oTable = oDoc.Tables.Add(oRange, iTotalRows, iTotalCols)
    oTable.Borders.Enable = True      ' YES, WE WANT BORDERS.

    Dim iRows, iCols As Integer
    oTable.Cell(iRows, iCols).Range.Font.Bold = True        

    ' 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("Table1").Cells(iRows, iCols)
            oTable.Cell(iRows, iCols).Range.text = txt        ' COPY (OR WRITE) DATA TO THE TABLE.
        Next iCols
    Next iRows
    Set oTable = Nothing
    Set oDoc = Nothing
    Set oWord = Nothing

End Sub

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

2 个答案: