我正在使用Excel 2013来遍历一系列附加了超链接的单元格。超链接导致word文件,其中可能有也可能没有表。如果它们确实包含表,则将表提取并转储到另一个word文档,该文档收集所有单个文档的所有表。我已经能够成功编码,但有一点需要注意。这些表通常包含一行或两行(基本上是标题),我也想提取它们。包含图像以获得视觉感受:
但是,我尝试过这方面的信息并没有成功,并会对如何做到这一点的任何建议表示感谢?我对word-VBA相当新鲜。可能有办法在表格正上方指定范围吗?到目前为止我的代码:
Private Sub Table_Importing()
Dim name_cell As Hyperlink:
Dim TableNo As Integer:
Dim t As Word.Table:
Dim rng As Word.Range:
Dim exportdoc As Word.Document
Dim objdoc As Word.Document
Set all_names = datasheet.Range("B2:B" & lastdatarow)
Set objWord = CreateObject("Word.Application")
Set exportdoc = objWord.Documents.Add
objWord.ActiveDocument.SaveAs "Monthly_Bluebooks_FP_Tables.docx"
objWord.Visible = False
For Each name_cell In all_names.Hyperlinks
UserForm1.Label1.Caption = "Extracting table from " & name_cell.Name
Set objdoc = objWord.Documents.Open(name_cell.Address, ReadOnly:=True)
TableNo = objdoc.Tables.Count
If TableNo > 0 Then
Set rng = exportdoc.Range
rng.Collapse wdCollapseEnd
rng.Font.Bold = wdToggle
rng.Font.Size = 14
rng.Text = name_cell.Name
rng.Font.Bold = wdToggle
rng.Collapse wdCollapseEnd
rng.InsertBreak (wdLineBreak)
rng.Text = vbCrLf
rng.Collapse wdCollapseEnd
For Each t In objdoc.Tables
'I believe title extraction would go here
Set rng = exportdoc.Range
rng.Collapse wdCollapseEnd
rng.FormattedText = t.Range.FormattedText
rng.Collapse wdCollapseEnd
rng.Text = vbCrLf
Next t
rng.Collapse wdCollapseEnd
rng.InsertBreak (wdPageBreak)
rng.Text = vbCrLf
objdoc.Close (wdDoNotSaveChanges)
Else
'No tables found, close the word document
objdoc.Close (wdDoNotSaveChanges)
End If
Next name_cell
For Each t In exportdoc.Tables
With exportdoc
t.AutoFitBehavior wdAutoFitWindow
End With
Next t
objWord.Visible = True
exportdoc.Activate
End Sub