如何将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 

我再强调整个输出新文件并将其转换为表格。我遇到的唯一问题是容易修复的“空白”第一列，然后添加必要的标题格式。

希望别人觉得这很有用。