Question

我有一个word文档：

Table 1

A      A
B      B

Table 2

C      C
D      D

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

Excel中：

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

以下代码仅复制word文档中的最后一个表。产生这个结果：

Excel中：

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

Answer 1

您只循环遍历一个表中的单元格，而您还需要遍历文档中的每个表格。

您可以尝试这样的事情......

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

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

1 个答案: