根据页码从word文档中提取一系列表格

Extract a range of tables from word document based on page number

我的 Word 文档有 50 table 篇,大约有 100 页,

  1. 我想知道如何根据第number/range页提取table,例如从第48页到第56页提取table .目前我正在使用的代码 它是根据 word 文档中的 table 索引提取的。从最终用户的角度来看,找到 table 索引并将其输入 Popup MessageBox 会很乏味。

  2. 我们如何使用文件路径作为用户的输入。他们可以在以下变量中输入文件名或文件路径

"设置 wdDoc = .Documents.Open(ActiveWorkbook.Path & "\fivetables.docx")"

代码当前使用-

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(ActiveWorkbook.Path & "\fivetables.docx")
  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 

例如:

Sub ImportWordTables()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim wdRng As Word.Range, wdTbl As Word.Table
Dim xlWkSht As Worksheet, i As Long, j As Long, p As Long
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Open(FileName:=ActiveWorkbook.Path & "\fivetables.docx", AddToRecentFiles:=False)
  With wdDoc
    p = .ComputeStatistics(wdStatisticPages)
    i = CLng(InputBox("The document has " & p & " pages." & vbCr & _
        "Page to start at?"))
    If i < 1 Then GoTo ErrExit
    If i > p Then GoTo ErrExit
    j = CLng(InputBox("The document has " & p & " pages." & vbCr & _
        "Page to end at?"))
    If j > p Then j = p
    Set wdRng = .Range.GoTo(What:=wdGoToPage, Name:=i).GoTo(What:=wdGoToBookmark, Name:="\page")
    wdRng.End = .Range.GoTo(What:=wdGoToPage, Name:=j).GoTo(What:=wdGoToBookmark, Name:="\page").End
    For Each wdTbl In wdRng.Tables
      wdTbl.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