宏导出MS Word表到Excel表

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表吗?

4 个解决方案

#1

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://damonostrander.com)

#2

Love it, this is absolutely brilliant, Damon (even if it took me over a year to find...). Here's my final code with 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中提取表中的表……我真的想吗?

#3

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

#4

Thank you so much Damon and @Tim

非常感谢Damon和@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

#1