使用VBA宏提取表格上方的段落或行

时间:2016-10-19 17:11:18

标签: excel vba excel-vba word-vba

我正在使用Excel 2013来遍历一系列附加了超链接的单元格。超链接导致word文件,其中可能有也可能没有表。如果它们确实包含表,则将表提取并转储到另一个word文档,该文档收集所有单个文档的所有表。我已经能够成功编码,但有一点需要注意。这些表通常包含一行或两行(基本上是标题),我也想提取它们。包含图像以获得视觉感受:

enter image description here

但是,我尝试过这方面的信息并没有成功,并会对如何做到这一点的任何建议表示感谢?我对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

0 个答案:

没有答案