Извлечь заголовок из Word в Excel

Question

У меня есть документ Word, который содержит комментарии.Я написал скрипт для извлечения в Excel:

1. Номер комментария
2. Номер страницы
3. Первый инициал комментатора
4. Фамилия комментатора
5. Дата написания комментария
6. Фактический комментарий

Проблема, которую я не могу понять, заключается в том, что мне нужно также извлечь номер заголовка и текст этого заголовка,Мне нужен седьмой столбец для заголовка, в котором находится комментарий. Например, допустим, у меня был комментарий в разделе, озаглавленном «4.1 Это заголовок».Мне нужно извлечь номер заголовка (4.1) и текст заголовка (это заголовок) вместе с соответствующим комментарием.

Для создания заголовков я использовал функцию «Заголовки» в Word на вкладке «Главная» ленты в разделе «Стили».

Вот что я написал до сих пор:

 Sub Export_Comments()

' Purpose: Search for comments in any text that's been pasted into
' this document, then export them into a new Excel spreadsheet.
' Requires reference to Microsoft Excel 15.0 Object Library in VBA,
' which should already be saved with as part of the structure of
' this .docm file.

Dim bResponse As Integer

' Exit routine if no comments have been found.
If ActiveDocument.Comments.Count = 0 Then
  MsgBox ("No comments found in this document")
  Exit Sub
Else
  bResponse = MsgBox("Do you want to export all comments to an Excel worksheet?", _
              vbYesNo, "Confirm Comment Export")
  If bResponse = 7 Then Exit Sub
End If

' Create a object to hold the contents of the
' current document and its text. (Shorthand
' for the ActiveDocument object.
Dim wDoc As Document
Set wDoc = ActiveDocument

' Create objects to help open Excel and create
' a new workbook behind the scenes.
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook

Dim i As Integer
Dim oComment As Comment         'Comment object

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

' Create a new Workbook. Shouldn't interfere with
' other Workbooks that are already open. Will have
' at least one worksheet by default.
Set xlWB = xlApp.Workbooks.Add

With xlWB.Worksheets(1).Range("A1")

  ' Create headers for the comment information
  .Offset(0, 0) = "Comment Number"
  .Offset(0, 1) = "Page Number"
  .Offset(0, 2) = "Reviewer Initials"
  .Offset(0, 3) = "Reviewer Name"
  .Offset(0, 4) = "Date Written"
  .Offset(0, 5) = "Comment Text"

  ' Export the actual comments information
  For i = 1 To wDoc.Comments.Count

    Set oComment = wDoc.Comments(i)
    .Offset(i, 0) = oComment.Index                                                'Comment Number
    .Offset(i, 1) = oComment.Reference.Information(wdActiveEndAdjustedPageNumber) 'Page Number
    .Offset(i, 2) = oComment.Initial                                              'Author Initials
    .Offset(i, 3) = oComment.Author                                               'Author Name
    .Offset(i, 4) = Format(oComment.Date, "mm/dd/yyyy")                           'Date of Comment
    .Offset(i, 5) = oComment.Range                                                'Actual Comment
  Next i

End With

' Make the Excel workbook visible
xlApp.Visible = True

' Clean up our objects
Set oComment = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

Answer 1

Вы можете получить заголовок (определенный путем применения одного из девяти возможных стилей заголовков) для определенного местоположения, используя встроенную закладку с именем \HeadingLevel.Чтобы это работало, выбор должен быть в этом диапазоне.Это возвращает весь текст под заголовком , поэтому его необходимо свернуть до начальной точки, затем код работает с этим абзацем, чтобы получить ListString (нумерацию) и текст.

Диапазон комментариев в документе: Comment.Reference.

. Исходя из вашего кода, в моей тестовой среде (Word) работает следующее:

Dim rngComment As Word.Range, rngHeading As Word.Range

Set rngComment = oComment.Reference
rngComment.Select
Set rngHeading = ActiveDocument.Bookmarks("\HeadingLevel").Range
rngHeading.Collapse wdCollapseStart
Set rngHeading = rngHeading.Paragraphs(1).Range
Debug.Print rngHeading.ListFormat.ListString & " " & rngHeading.Text

Я не могу дублировать вашиокружение, но следующее должно работать

 For i = 1 To wDoc.Comments.Count
   Set oComment = wDoc.Comments(i)
   Set rngComment = oComment.Reference
   rngComment.Select
   Set rngHeading = wDoc.Bookmarks("\HeadingLevel").Range
   rngHeading.Collapse wdCollapseStart
   Set rngHeading = rngHeading.Paragraphs(1).Range
  .Offset(i, 0) = oComment.Index
  .Offset(i, 1) = oComment.Reference.Information(wdActiveEndAdjustedPageNumber)
  .Offset(i, 2) = oComment.Initial    
  .Offset(i, 3) = oComment.Author
  .Offset(i, 4) = Format(oComment.Date, "mm/dd/yyyy")
  .Offset(i, 5) = oComment.Range
  .Offset(i, 6) = rngHeading.ListFormat.ListString & " " & rngHeading.Text
Next i