从word文档和表数据VBA中抓取文本/标题



目前,我正在使用下面的脚本从word文档中捕获表格,并将它们作为单独的工作表存储在Excel工作簿中。这些页面有2-3行文本/页眉,表后有2-3行文本。

随着表,我想提取的文本之前和之后的表到相同的工作表作为表。

例如在第1页我有- "textbeforetable_page1", textaftertable_page1;这应该在与table_page1相同的工作表中提取。

当前使用-

的代码
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 & "documentname.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("A2").CurrentRegion.EntireColumn.AutoFit
Next
ErrExit:
.Close False
End With
.Quit
End With
Application.ScreenUpdating = True
End Sub

直接修改:

wdTbl.Range.Copy

:

With wdTbl.Range
.MoveStart wdParagraph, -1
.MoveEnd wdParagraph, 1
.Copy
End With

最新更新