Извлечение заголовков и нумерации страниц оглавления документа Word с помощью VBA

в основном то, что у нас здесь

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

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

но мне нужен номер страницы для каждого заголовком.

Я попытался выполнить поиск по каждому заголовку, выбрать результат поиска и получить wdActiveEndPageNumber.

Это не сработало, было медленным и уверенным уродливым подходом.

Я хотел бы вставить найденный материал в другой документ word, например: ГСЧ.Страница InsertAfter ": " & pageNum & "Header:" & strText & vbNewLine

7
ms-word vba word-vba

3 ответов

Я не могу понять вопрос, но этот код проходит через документ, ища строки, которые являются только заголовками, и получает страницу. 

Public Sub SeeHeadingPageNumber()
    On Error GoTo MyErrorHandler

    Dim sourceDocument As Document
    Set sourceDocument = ActiveDocument

    Dim myPara As Paragraph
    For Each myPara In sourceDocument.Paragraphs
        myPara.Range.Select 'For debug only
        If InStr(LCase$(myPara.Range.Style.NameLocal), LCase$("heading")) > 0 Then
            Debug.Print myPara.Range.Information(wdActiveEndAdjustedPageNumber)
        End If

        DoEvents
    Next

    Exit Sub

MyErrorHandler:
    MsgBox "SeeHeadingPageNumber" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
6

попробуйте использовать поле таблицы содержимого. Следующий код препарирует TOC и дает вам элемент, номер страницы и стиль. Возможно, вам придется проанализировать каждую строку, чтобы получить точную информацию или форматирование.

Public Sub SeeTOCInfo()
    On Error GoTo MyErrorHandler

    Dim sourceDocument As Document
    Set sourceDocument = ActiveDocument

    Dim myField As Field
    For Each myField In sourceDocument.TablesOfContents(1).Range.Fields
        Debug.Print Replace(myField.Result.Text, Chr(13), "-") & " " & " Type: " & myField.Type
        If Not myField.Result.Style Is Nothing Then
            Debug.Print myField.Result.Style
        End If
        DoEvents
    Next

    Exit Sub

MyErrorHandler:
    MsgBox "SeeTOCInfo" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
0

это вставит номер страницы ссылочного заголовка:

rng.InsertCrossReference ReferenceType:=wdRefTypeHeading, _
            ReferenceKind:=wdPageNumber, ReferenceItem:=intItem

но работает только при вставке в тот же документ. Можно вставить в текущий документ, а затем вырезать/вставить в новый документ.

0