VBA将word doc中表格中的文本复制到excel？

debugcn 发表于 Dev

用户7415328

我有一个word文档：

Table 1

A      A
B      B

Table 2

C      C
D      D

我正在尝试将 word 文档中表格中的每段文本复制到 excel 中的单元格中，如下所示：

电子表格：

Column A      Column B
A             A
B             B
C             C
D             D

下面的代码只是复制我的 Word 文档中的最后一个表格。产生这个结果：

电子表格：

Column A     Column B
C            C
D            D

这是我的代码：

Sub ImportWordTable()
Dim objWord As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

Set objWord = GetObject(, "Word.Application")

Set wdDoc = objWord.ActiveDocument

With wdDoc
TableNo = wdDoc.tables.Count
    If .tables.Count > 0 Then
    With .tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
    End If
End With

Set wdDoc = Nothing

End Sub

请有人告诉我我哪里出错了？我想我需要为 TableNo 的每个循环添加一个

就像是

For Each TableNo In wdDoc
Next TableNo

Subodh Tiwari sktneer

您仅循环浏览一个表格中的单元格，而您还需要循环浏览文档中的每个表格。

你可以试试这样的...

Sub ImportWordTable()
Dim objWord As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim i As Long
Dim r As Long, c As Long
Set objWord = GetObject(, "Word.Application")

Set wdDoc = objWord.ActiveDocument
r = 1
c = 1
With wdDoc
TableNo = wdDoc.tables.Count
    If .tables.Count > 0 Then
        For i = 1 To TableNo
            With .tables(i)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                        Cells(r, c) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                        c = c + 1
                    Next iCol
                    c = 1
                    r = r + 1
                Next iRow
            End With
            c = 1
        Next i
    End If
End With
Set wdDoc = Nothing
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。