使用ms字VBA自动编号

Question

假设，我有一个Word文件，其中包含以下文本：

1. 此文本1
2. 此文字2
3. 此文字3
4. 此文字4
5. 此文字5
6. 本文6

现在，我要自动编号，结果如下：

1. 此文本1
2. 此文字2
3. 此文字3
4. 此文字4
5. 此文字5
6. 本文6

我正在使用以下代码，但是它不起作用。

Sub DoAutoNumber()

Const S_FIND As String = "([0-9]@)[.|]"
Dim myNumber As Integer

    myNumber = 1

    Do While InStr(ActiveDocument.Content, S_FIND) > 0
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Text = S_FIND
            .MatchWildcards = True
            .Font.Color = wdColorViolet
            .Execute Replace:=wdReplaceOne, ReplaceWith:="(" & myNumber & ")", _
                     Forward:=True
        End With
        myNumber = myNumber + 1
    Loop

End Sub

你能建议我吗？ 谢谢。

Answer 1

运行此宏（Sub CorrectNumbers），这应该可以解决问题。不知何故我需要做2个循环，因为正向循环并没有结束，因为SearchString总是被相同的指标所取代，并且循环又一次又一次地开始。这就是为什么我添加了一个临时持有人（$temp§）

Sub CorrectNumbers()

Dim Rng As Range: Set Rng = ActiveDocument.Range
Dim SearchString$
Dim SearchString2$: SearchString2 = "§temp§"
Dim myNumber%: myNumber = 1

SearchString = "([0-9]@)[.]"
    With Rng.Find
    .MatchWildcards = True
    .Forward = True
        Do While .Execute(FindText:=SearchString, ReplaceWith:=myNumber & "§temp§.") = True
        myNumber = myNumber + 1
        Rng.Collapse wdCollapseStart
        Loop
    End With

    With Rng.Find
    .MatchWildcards = False
    .Forward = True
        Do While .Execute(FindText:=SearchString2, ReplaceWith:="", Wrap:=wdFindContinue, Replace:=wdReplaceOne) = True
        Rng.Collapse wdCollapseStart
        Loop
    End With
End Sub

之前：

之后：

Answer 2

这是我测试过的代码。您可以尝试

Sub Demo()
 With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
    .NumberFormat = "%1."
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = CentimetersToPoints(0)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = CentimetersToPoints(0.74)
    .TabPosition = CentimetersToPoints(0.74)
    .ResetOnHigher = 0
    .StartAt = 1
    .LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
    wdNumberGallery).ListTemplates(1), ContinuePreviousList:=False, ApplyTo:= _
    wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
End Sub

希望有帮助！