VBA如何操控自动编号

过客fppt

大家好，这是一段通过录制宏修改出来的代码，但是没有达到效果
Sub 选区内重新编号_待调试()
    Dim a, b, i
    Dim rng As Range
    Set rng = Selection.Range
    For i = 1 To rng.ListParagraphs.count
        rng.ListParagraphs(i).Range.Select
        a = Selection.Range.ListFormat.ListValue
        If a <> i Then
            rng.ListParagraphs(i).ListAdvanceTo Level1:=i
        End If
    Next
    Set rng = Nothing
End Sub
原文档


希望达到的效果
1、选中全部运行代码时：所有编号连续

2、选中其中某一部分运行代码时，各部分编号从1开始


希望大家指点一下，谢谢

413191246se

nonononono

413191246se

* Corrected Code:

1. Sub AutoNumSelection()
   
2.     Dim r As Range, i As Paragraph, n&
   
3.    
   
4.     Set r = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
   
5.     ActiveDocument.ConvertNumbersToText
   
6.     r.Find.Execute "([0-9]@)(.^9)", , , 1, , , , , , "1\2", 2
   
7.    
   
8.     For Each i In r.Paragraphs
   
9.         With i.Range
   
10.             If .Text Like "1." & vbTab & "*" Then
    
11.                 .Font.ColorIndex = wdPink
    
12.                 n = n + 1
    
13.                 .Characters(1).Text = n
    
14.             End If
    
15.         End With
    
16.     Next
    
17. End Sub

复制代码

过客fppt

413191246se 发表于 2024-3-24 02:59
* Corrected Code:

先谢谢413191246se老师，我后面再用电脑验证一下

batmanbbs

过客fppt

非常感谢batmanbbs老师和413191246se的帮助
但是413191246se老师的代码运行后没有反应
batmanbbs老师的代码做不到选择一部分内容时，使选中内的自动编号从1开始，选中全部时，可以让所有编号连续起来

感觉挺难的，我还是手动操作吧，谢谢各位

batmanbbs

过客fppt 发表于 2024-3-24 18:52
非常感谢batmanbbs老师和413191246se的帮助
但是413191246se老师的代码运行后没有反应
batmanbbs老师的 ...

我就是这样设计的，上一段代码就是从选中的开始继续重新编号。如果必须从1开始，代码如下：

413191246se

过客 老师：我虽然没有 batmanbbs 老师 的水平高，但我的代码怎么会没有反应呢？我是反复测试后才发布的，请重新测试一下，在你原 demo 文档的基础上（我承认，我是将自动编号变成了手动编号）。

batmanbbs

413191246se 发表于 2024-3-25 02:47
过客 老师：我虽然没有 batmanbbs 老师 的水平高，但我的代码怎么会没有反应呢？我是反复测试后才发布的， ...

se老师太谦虚了，算是本人的启蒙老师，写代码的水平可一点都不低。PS：测试了，没有问题

过客fppt

413191246se 发表于 2024-3-25 02:47
过客 老师：我虽然没有 batmanbbs 老师 的水平高，但我的代码怎么会没有反应呢？我是反复测试后才发布的， ...

因为我是希望用代码控制自动编号，一直是在自动编号的状态下测试的，可能这是没有反应的原因