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

我有一个单词文件：

Table 1 AA BB Table 2 CC DD 

我试图从word文档中的表格中将每段文本复制到Excel中的单元格，如下所示：

Excel中：

 Column A Column B AA BB CC DD 

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

Excel中：

 Column A Column B CC DD 

这是我的代码：

 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