1

我需要将使用大纲视图开发的 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
----------------------------------------
4

1 回答 1

1

根据要求，这是答案。

解决方案： 我在这里使用了代码：从 Word 文档中获取标题，这是一个很好的开始 - 感谢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

然后，我在新文档中突出显示了整个输出并将其转换为表格。我遇到的唯一问题是“空白”的第一列很容易修复，然后为标题添加了必要的格式。

希望其他人觉得这很有用。

于 2013-05-26T14:54:10.173 回答