将 MS Word 表格导出到 Excel 工作表的宏

Question

我有一个包含许多表格的 word 文档。有谁知道如何编写一个宏来将这些表格导出到不同的 Excel 工作表？

Answer 1

答案来自：http://www.mrexcel.com/forum/showthread.php?t=36875

下面是一些从 Word 中将表格读取到 Excel 的活动工作表中的代码。如果 Word 包含多个表格，它会提示您输入 word 文档以及表格编号。

Sub ImportWordTable()
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

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    TableNo = wdDoc.tables.Count
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf TableNo > 1 Then
        TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
        "Enter table number of table to import", "Import Word Table", "1")
    End If
    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 With

Set wdDoc = Nothing

End Sub

此宏应插入 Excel（而不是 Word）并放入标准宏模块而不是工作表或工作簿事件代码模块。为此，请转到 VBA（键盘 Alt-TMV），插入宏模块 (Alt-IM)，然后将代码粘贴到代码窗格中。从 Excel 界面运行宏，就像在任何其他界面（Alt-TMM）一样。

如果您的文档包含许多表格，例如，如果您的 100 多页表格实际上是每一页上的单独表格，则可以轻松修改此代码以读取所有表格。但现在我希望它是一张连续的表格，不需要任何修改。

---

保持卓越。

达蒙

VBAexpert Excel 咨询 （我的另一半：http://damonostrander.com）

Answer 2

我更改了this one，添加了循环遍历所有表（从所选表开始）：

Option Explicit

Sub ImportWordTable()

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 resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer

On Error Resume Next

ActiveSheet.Range("A:AZ").ClearContents

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    tableNo = wdDoc.tables.Count
    tableTot = wdDoc.tables.Count
    If tableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf tableNo > 1 Then
        tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
        "Enter the table to start from", "Import Word Table", "1")
    End If

    resultRow = 4

    For tableStart = 1 To tableTot
        With .tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                Next iCol
                resultRow = resultRow + 1
            Next iRow
        End With
        resultRow = resultRow + 1
    Next tableStart
End With

End Sub

下一个技巧：研究如何从 Word 中提取表格中的表格......我真的想要吗？

TC

Answer 3

非常感谢 Damon 和 @Tim

我修改它以打开 docx 文件，在检查用户转义后移动了一个工作表清除行。

这是最终代码：

Option Explicit

Sub ImportWordTable()

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 resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer

On Error Resume Next

wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

ActiveSheet.Range("A:AZ").ClearContents

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    tableNo = wdDoc.tables.Count
    tableTot = wdDoc.tables.Count
    If tableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf tableNo > 1 Then
        tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
        "Enter the table to start from", "Import Word Table", "1")
    End If

    resultRow = 4

    For tableStart = tableNo To tableTot
        With .tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                Next iCol
                resultRow = resultRow + 1
            Next iRow
        End With
        resultRow = resultRow + 1
    Next tableStart
End With

End Sub

Answer 4

这部分代码是循环遍历每个表并将其复制到 excel 中的代码。也许您可以创建一个工作表对象，使用表号作为计数器动态更新您所指的工作表。

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 With