Получение заголовков из документа Word

Question

Получение заголовков из документа Word

Как я получаю список всех заголовков, одним словом, документ при помощи VBA?

22

задан shruti1810 27 May 2015 в 06:17

2 ответа

Самый легкий способ получить список заголовков, должен циклично выполниться через абзацы в документе, например:

 Sub ReadPara()

    Dim DocPara As Paragraph

    For Each DocPara In ActiveDocument.Paragraphs

     If Left(DocPara.Range.Style, Len("Heading")) = "Heading" Then

       Debug.Print DocPara.Range.Text

     End If

    Next


End Sub

Между прочим, я нахожу, что это - хорошая идея удалить последний символ диапазона абзаца. Иначе при отправке строки в окно сообщения или документ Word отображает дополнительный управляющий символ. Например:

Left(DocPara.Range.Text, len(DocPara.Range.Text)-1)

14

ответ дан JonnyGold 29 November 2019 в 04:57

Другие вопросы по тегам:

word-vba ms-word vba

Похожие вопросы:

score 18 · Accepted Answer

Вы имеете в виду как этот функция createOutline (которые на самом деле копируют все заголовки с документа исходного слова в новый документ слова):

(я верю astrHeadings = _docSource.GetCrossReferenceItems(wdRefTypeHeading), функция является ключом в этой программе и должна позволить Вам получать то, что Вы просите)

Public Sub CreateOutline()
    Dim docOutline As Word.Document
    Dim docSource As Word.Document
    Dim rng As Word.Range

    Dim astrHeadings As Variant
    Dim strText As String
    Dim intLevel As Integer
    Dim intItem As Integer

    Set docSource = ActiveDocument
    Set docOutline = Documents.Add

    ' Content returns only the
    ' main body of the document, not
    ' the headers and footer.
    Set rng = docOutline.Content
    astrHeadings = _
     docSource.GetCrossReferenceItems(wdRefTypeHeading)

    For intItem = LBound(astrHeadings) To UBound(astrHeadings)
        ' Get the text and the level.
        strText = Trim$(astrHeadings(intItem))
        intLevel = GetLevel(CStr(astrHeadings(intItem)))

        ' Add the text to the document.
        rng.InsertAfter strText & vbNewLine

        ' Set the style of the selected range and
        ' then collapse the range for the next entry.
        rng.Style = "Heading " & intLevel
        rng.Collapse wdCollapseEnd
    Next intItem
End Sub

Private Function GetLevel(strItem As String) As Integer
    ' Return the heading level of a header from the
    ' array returned by Word.

    ' The number of leading spaces indicates the
    ' outline level (2 spaces per level: H1 has
    ' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.

    Dim strTemp As String
    Dim strOriginal As String
    Dim intDiff As Integer

    ' Get rid of all trailing spaces.
    strOriginal = RTrim$(strItem)

    ' Trim leading spaces, and then compare with
    ' the original.
    strTemp = LTrim$(strOriginal)

    ' Subtract to find the number of
    ' leading spaces in the original string.
    intDiff = Len(strOriginal) - Len(strTemp)
    GetLevel = (intDiff / 2) + 1
End Function

ОБНОВЛЕНИЕ @kol 6 марта 2018

, Хотя astrHeadings массив (IsArray возвраты True, и TypeName возвраты String()), я добираюсь type mismatch ошибка, когда я пытаюсь получить доступ к ее элементам в VBScript (v5.8.16384 в Windows 10 Pro 1709 16299.248). Это должно быть определенной для VBScript проблемой, потому что я могу получить доступ к элементам, если я выполняю тот же код в редакторе Word VBA. Я закончил тем, что выполнил итерации строк TOC, потому что он работает даже от VBScript:

For Each Paragraph In Doc.TablesOfContents(1).Range.Paragraphs
  WScript.Echo Paragraph.Range.Text
Next