从word文档中提取一系列表格

Question

我的Word文档里面有50个table，我想知道如何从word文档中提取table第20到table第30个字。目前我正在使用的代码是从 word 文档中提取所有 tables。另外，如果可能的话，我们可以允许用户在脚本为运行时输入范围吗？

 Option Explicit

Sub ImportWordTables()

    Dim wd As Word.Application
    Dim doc As Word.Document
    Dim tbl As Word.Table
    Dim ws As Worksheet
    Set wd = New Word.Application
    wd.Visible = True
    
    Set doc = wd.Documents.Open(ThisWorkbook.Path & "\fivetables.docx")
    
    For Each tbl In doc.Tables
    
        tbl.Range.Copy
        Set ws = ThisWorkbook.Worksheets.Add
        ws.PasteSpecial "HTML"
        ws.Range("A1").CurrentRegion.EntireColumn.AutoFit
        
    Next tbl
    
    doc.Close
    wd.Quit
    
End Sub

Answer 1

你的问题的基本答案是使用Tables-Collection的Item-属性来检索指定范围的tables

我会将代码分成四个部分：

主程序（importWordTables）
sub 获取 table 索引的用户输入 getTableIndeces
检查输入数据是否有效并在输入不正确时引发错误的子程序checkValidIndexInput
sub 导入用户 importWordTablesFromTo.
最后但同样重要的是，我正在使用一个函数来获取 WordApp - returns 如果打开则为 word 的当前实例，否则将打开 word。 getWordApp

Public Sub importWordTables()

On Error GoTo err_Import

    Dim wd As Word.Application
    Dim doc As Word.Document
    
    Set wd = getWordApp
    
    'Set doc = wd.Documents.Open(ThisWorkbook.Path & "\fivetables.docx")
        
    Dim iFrom As Long, iTo As Long
    
    getTableIndeces doc, iFrom, iTo
    
    importWordTablesFromTo doc, iFrom, iTo
    
    doc.Close
    
exit_Import:
    If Not doc Is Nothing Then doc.Close
    Exit Sub
    
err_Import:
    MsgBox Err.Description, vbCritical
    Resume exit_Import

End Sub

获取并检查 table 索引：

Private Sub getTableIndeces(doc As Word.Document, ByRef iFrom As Long, ByRef iTo As Long)

Dim cntTables As Long
cntTables = doc.Tables.Count

Dim varFrom As Variant, varTo As Long

varFrom = InputBox("Index of first table to be imported (no of tables: " & cntTables & ")", "Import tables: first table", 1)
checkValidIndexInput varFrom, cntTables

iFrom = varFrom


varTo = InputBox("Index of last table to be imported (no of tables: " & cntTables & ")", "Import tables: last table", cntTables)
checkValidIndexInput varTo, cntTables, iFrom
iTo = varTo


End Sub

Private Sub checkValidIndexInput(ByVal varIndex As Variant, ByVal cntTables As Long, Optional iFrom As Long)
If Not IsNumeric(varIndex) Then 'not a number
    Err.Raise vbObjectError, , "Please enter a valid number as index."
    
ElseIf varIndex < 0 Or varIndex > cntTables Then  'not within range
    Err.Raise vbObjectError, , "Index of the table has to be between 1 and " & cntTables & "."

ElseIf iFrom > 0 And varIndex < iFrom Then
    Err.Raise vbObjectError, , "Index of last table has to be greater than index of first table (" & iFrom & ")."
End If
End Sub

正在将选定的 table 范围写入当前工作簿：

Sub importWordTablesFromTo(doc As Word.Document, iFrom As Long, iTo As Long)

    Dim i As Long, tbl As Word.Table, ws As Worksheet
    
    For i = iFrom To iTo   
        Set tbl = doc.Tables.Item(i)     '---> retrieve the specified table
        
        tbl.Range.Copy
        Set ws = ThisWorkbook.Worksheets.Add
        ws.PasteSpecial "HTML"
        ws.Range("A1").CurrentRegion.EntireColumn.AutoFit
        
    Next
       
End Sub

检索当前或新单词实例：

Private Function getWordApp() As Word.Application

Dim WordApp As Word.Application

On Error Resume Next    'in case Word isn't already open
Set WordApp = GetObject(, "Word.Application")
If Err > 0 Or WordApp Is Nothing Then
    Set WordApp = CreateObject("Word.Application")
End If

WordApp.Visible = True

Set getWordApp = WordApp
End Function

Answer 2

例如：

Sub ImportWordTables()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim xlWkSht As Worksheet, i As Long, j As Long, t As Long
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Open(FileName:=ActiveWorkbook.Path & "\fivetables.docx", AddToRecentFiles:=False)
  With wdDoc
    t = .Tables.Count
    i = CLng(InputBox("The document has " & t & " tables." & vbCr & _
        "Table to start at?"))
    If i < 1 Then GoTo ErrExit
    If i > t Then GoTo ErrExit
    j = CLng(InputBox("The document has " & t & " tables." & vbCr & _
        "Table to end at?"))
    If j > t Then j = t
    For t = i To j
      .Tables(t).Range.Copy
      Set xlWkSht = ActiveWorkbook.Worksheets.Add
      xlWkSht.PasteSpecial "HTML"
      xlWkSht.Range("A1").CurrentRegion.EntireColumn.AutoFit
    Next
ErrExit:
    .Close False
  End With
  .Quit
End With
Application.ScreenUpdating = True
End Sub

从word文档中提取一系列表格

Extract a range of tables from word document

excel

vba

ms-word