vba 将 MS Word 表格导出到 Excel 表格的宏

Macro to export MS Word tables to Excel sheets

提问by QLands

I have a word document with many tables. Does anyone know how to write a macro to export such tables to different Excel sheets?

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

回答by Bnjmn

Answer taken from: http://www.mrexcel.com/forum/showthread.php?t=36875

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

Here is some code that reads a table from Word into the active worksheet of Excel. It prompts you for the word document as well as the table number if Word contains more than one table.

下面是一些将 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

This macro should be inserted into Excel (not Word) and put into a standard macro module rather than into the worksheet or workbook event code modules. To do this, go to the VBA (keyboard Alt-TMV), insert a macro module (Alt-IM), and paste the code into the code pane. Run the macro from the Excel interface as you would any other (Alt-TMM).

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

If your document contains many tables, as would be the case if your 100+ page table is actually a separate table on each page, this code could easily be modified to read all the tables. But for now I am hoping it is all one continuous table and will not require any modification.

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

---

---

Keep Excelling.

保持卓越。

Damon

达蒙

VBAexpert Excel Consulting (My other life: http://damonostrander.com)

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

回答by Tim

I changed this onewith an addition to loop through all tables (starting from the chosen table):

我改变了这个，增加了循环遍历所有表（从所选表开始）：

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

Next trick: working out how to extract a table within a table from Word... and do I really want to?

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

TC

技术委员会

回答by Sujay Phadke

Thank you so much Damon and @Tim

非常感谢达蒙和@Tim

I modified it to open docx files, moved a worksheet clear line after checking for escape by user.

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

Here is the final code:

这是最终的代码：

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

回答by Bnjmn

This section of code is the one that loops through each table and copies it to excel. Perhaps you could create a worksheet object that dynamically updates the worksheet you are referring to using the table number as a counter.

这部分代码是循环遍历每个表并将其复制到 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