如何在用VBA将所有段落转换成Word文档中的一个表格后重新排列缩进？

Question

我经常处理大型Word文档。我得把所有段落转换成一张表。

源文档结构示例：

转换后（插入->表->将文本转换为表），Word将丢失有关随机段落缩进的信息。目标文件：

Dim sourceDocument, targetDocument As Document
Dim myRange As Range
Set sourceDocument = ActiveDocument
Set targetDocument = Documents.Add(ActiveDocument.FullName)
Set myRange = targetDocument.Range(Start:=targetDocument.paragraphs(1).Range.Start, End:=targetDocument.paragraphs(targetDocument.paragraphs.Count).Range.End)
myRange.converttotable Separator:=wdSeparateByParagraphs
Dim i As Integer
For i = 1 To targetDocument.Tables(1).Range.Rows.Count
    targetDocument.Tables(1).Range.Rows(i).Range.Cells(1).Range.paragraphs(1).LeftIndent = sourceDocument.paragraphs(i).LeftIndent
    targetDocument.Tables(1).Range.Rows(i).Range.Cells(1).Range.paragraphs(1).FirstLineIndent = sourceDocument.paragraphs(i).FirstLineIndent
Next i

或者也许有另一种方法可以将段落转换为具有正确缩进的表？

Answer 1

有很多方法可以解决这个问题。经过一些考虑，我决定一个相当直接的方法是从源文档中获得一个表中没有的所有段落的数组。

当循环目标文档中的行时，只有在包含嵌套表的行中，段落数才会大于1。在本例中，范围被设置为末尾（最后一段）。

然后使用循环计数器（加上1，因为数组是从0开始的）从数组中的相应段落应用缩进。

Sub RestoreParaIndents()
    Dim sourceDocument As Document, targetDocument As Document
    Dim myRange As Range
    Set sourceDocument = ActiveDocument
    Set targetDocument = Documents.Add(ActiveDocument.FullName)
    Set myRange = targetDocument.content  

    'Get an array of all paragraphs not in a table in the source document
    'This will provide the indent information in the loop for the target document
    Dim aParas() As Paragraph, para As Paragraph
    Dim counterPara As Long
    counterPara = 0
    For Each para In sourceDocument.Paragraphs
        If Not para.Range.Information(wdWithInTable) Then
            ReDim Preserve aParas(counterPara)
            Set aParas(counterPara) = para
            counterPara = counterPara + 1
        End If
    Next

    myRange.ConvertToTable Separator:=wdSeparateByParagraphs

    Dim i As Long
    Dim rw As Row, rng As Range
    For i = 1 To targetDocument.Tables(1).Range.Rows.Count
        Set rw = targetDocument.Tables(1).Range.Rows(i)
        Set rng = rw.Range.Cells(1).Range

        'If the cell contains multiple paragraphs then in contains
        'a nested table. Skip the table and go to the end (last paragraph)
        If rng.Paragraphs.Count > 1 Then
            Set rng = rng.Paragraphs.Last.Range
        End If
        rng.Paragraphs(1).LeftIndent = aParas(i - 1).LeftIndent
        rng.Paragraphs(1).FirstLineIndent = aParas(i - 1).FirstLineIndent 
    Next i
End Sub