提取標題表與VBA

的PAGENUMBER的Word文檔的內容和基本上我們這裏有提取標題表與VBA

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

，但我需要爲每個標題太頁碼。

我試着搜索每個標題，選擇搜索結果並檢索wdActiveEndPageNumber。

這沒有奏效，速度很慢，肯定是一種醜陋的做法。

我想找到的東西粘貼到另一個Word文檔，如： rng.InsertAfter「頁面：」 &頁次&「標題：」 & strText的& vbNewLine

來源

2010-09-02 FTav

然後，我可能不明白這個問題，但是這段代碼遍歷文檔，尋找只有標題的行，並將頁面打開。

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

來源

2010-09-09 01:40:51 ForEachLoop

+1。這可能是最快/最簡單的方法。如果是我，我會接受這個答案。 – 2010-09-10 17:17:23

哇，很抱歉這麼晚回覆，謝謝你的回答。 – FTav 2013-03-15 16:27:48

嘗試使用內容字段的表。以下代碼解析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

來源

2010-09-07 14:57:01 ForEachLoop

這聽起來不錯，但我有可能以後擴展檢索到的信息，我不必似乎型「自由」與TOC：/ – FTav 2010-09-08 09:46:06

這將插入引用的標題的頁面數：

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

但是，只有當你在同一個文檔中插入的作品。您可以插入當前文檔，然後剪切/粘貼到新文檔。

來源

2010-09-07 20:51:38

這聽起來不錯，但究竟會插入和剪切/粘貼過程看起來像？對不起，我是一個真正的VBA初學者。 – FTav 2010-09-08 09:47:23

提取標題表與VBA

回答

相關問題