Extract Headings và PAGENUMBER của Table of Contents của một tài liệu Word với VBA

Question

Về cơ bản những gì chúng tôi có ở đây

Getting the headings from a Word document

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 

nhưng tôi cần số trang cho mỗi tiêu đề quá.

Tôi đã thử thực hiện tìm kiếm cho từng tiêu đề, chọn kết quả tìm kiếm và truy lục wdActiveEndPageNumber.

Điều này không hiệu quả, chậm và chắc chắn là một cách tiếp cận xấu xí.

Tôi muốn dán những thứ tìm thấy vào một tài liệu từ như: rng.InsertAfter "Page:" & pageNum & "Tiêu đề:" & strText & vbNewLine

Answer 1

Tôi có thể không hiểu câu hỏi, sau đó, nhưng mã này đi qua tài liệu, tìm kiếm các dòng chỉ là tiêu đề và nhận được trang của nó.

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 

Answer 2

Hãy thử sử dụng một bảng của lĩnh vực nội dung. Đoạn mã sau phân tích một TOC và cung cấp cho bạn mục, số trang và kiểu. Bạn có thể phải phân tích từng chuỗi để có được thông tin chính xác hoặc định dạng bạn cần.

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 

Answer 3

này sẽ chèn số trang của Tựa đề tham chiếu:

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

Nhưng chỉ hoạt động nếu bạn đang chèn trong cùng một tài liệu. Bạn có thể chèn vào tài liệu hiện tại và sau đó cắt/dán ra một tài liệu mới.