【VBA实战】Word文档中自动编号转手动编号

相信只有经常写项目文档的朋友才会理解为什么会有这样的需求。

项目文档通常都是拆分成几个部分，然后分给几个不同的人去写，最后在由专人进行合稿。如果分开的几个文档里有内容使用了Word的自动编号功能的话，那么在合稿时，很多时候都会出现编号错乱的问题，需要全文检查，人为修正。所以在分派文档工作的时候，有些团队会强调不要使用Word的自动编号功能，所有编号都手动来编，以保证在合稿时编号的正确性。

但是手动编号效率较低。更麻烦的是，当编号较多，或者编号层级较深的时候，很容易出现漏编错编的问题。虽然在合稿时不会出现编号错乱，但在写各个部分的文档时又需要多花费一些精力去保证编号的正确性。

那如果我们能在写文档的时候，使用自动编号功能，来提高写作效率；然后在合稿之前，将各文档的自动编号一建转换成手动编号，岂不是很完美？于是就有了本文的这个需求。VBA代码如下：

Sub 自动编号变手动编号()

    Dim p As Paragraph
    Dim mr As Range
    Dim arr() As String
    Dim i As Integer
    
    ReDim arr(1 To ActiveDocument.Paragraphs.Count + 1)
    
    i = 1
    '遍历全文所有段落
    For Each p In ActiveDocument.Paragraphs

        '当ListValue不为0时，说明段落有编号，将编号对应的文本串存储到arr中
        If p.Range.ListFormat.ListValue <> 0 Then
            arr(i) = p.Range.ListFormat.ListString
            i = i + 1
        End If
        
    Next p
    
    i = 1
    '遍历全文所有段落
    For Each p In ActiveDocument.Paragraphs

        '清除有编号段落的格式，并按顺序将保存的对应的编号文本串插入到段落前面
        If p.Range.ListFormat.ListValue <> 0 Then
            p.Range.ListFormat.ApplyNumberDefault
            p.Range.InsertBefore arr(i) + " "
            i = i + 1
            
        End If
        
    Next p
     
End Sub

代码里主要用到了ListFormat对象的几个属性和方法，在这儿简单介绍一下：

根据Office官方帮助文档，ListFormat对象代表可应用于范围中各段落的列表格式属性。其属性ListValue代表在区域中查找指定的 ListFormat 对象返回的第一个段落的数字值，而ListString表示指定的 ListFormat 对象的范围的第一个段落的列表值的字符串。如果段落没编号的话，那么ListValue为0。

同时我们还使用了ListFormat对象的ApplyNumberDefault方法，它会向指定的 ListFormat 对象的区域中的段落添加默认的编号格式，但如果段落已设置了编号列表格式，该方法将清除其中已有的编号和格式。