如何將msWord標題轉換爲表保留段落級別

Question

我需要將使用大綱視圖開發的Word文檔轉換爲表格，以保留標題級別並將其轉換爲列。格式如下：

======================================== 
Heading 1 | Heading 2 | Heading 3 
======================================== 
Title 1.0 | Title 1.1 | Title 1.1.1 
---------------------------------------- 
      | Title 1.2 | 
---------------------------------------- 
      | Title 1.3 | Title 1.3.1 
---------------------------------------- 
Title 2.0 | Title 2.1 | Title 2.1.1 
---------------------------------------- 

Answer 1

根據要求，這裏是答案。

解決方案： 我這裏使用的代碼：Getting the headings from a Word document這是一個偉大的開始 - 感謝VonC並取得一些器官功能障礙綜合徵的CreateOutline子程序：

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 
    ' ======================================== 
    ' Added a static variable to retain the 
    ' last paragraph outline level 
    ' ======================================== 
    Static intLastLevel 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))) 

     ' ======================================== 
     ' If the paragraph level is increasing, add a tab, 
     ' if decreasing add a new line, and insert the appropriate 
     ' tabs as prefix. 
     ' ======================================== 
     If intLevel > intLastLevel Then 
      strText = vbTab & strText 
     Else 
      strText = vbNewLine & String(intLevel, Chr(9)) & strText 
     End If 
     ' ======================================== 

     ' Add the text to the document. 
     rng.InsertAfter strText 
     ' Set the style of the selected range and 
     ' then collapse the range for the next entry. 
     ' rng.Style = "Heading " & intLevel  ' Removed the style setting 
     ' ======================================== 
     ' Remeber the current paragraph level 
     ' ======================================== 
     intLastLevel = 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 

我再強調整個輸出新文件並將其轉換爲表格。我遇到的唯一問題是容易修復的「空白」第一列，然後添加必要的標題格式。

希望別人覺得這很有用。