关于制度自动编号问题（第一条、第二条）

^天堂里的傻孩子

公司最近在组织大量制度的修订，其中就涉及到将以前制度格式的序号，改为第一条、第二条这种格式。
改一遍还好，如果前面要插入一条，后面的全部都要修改。
想研究个自动修改的VBA，检查每段前7个字（想了下，最多三位数的条，第一百九十九条，7个字）包含“第”“条”，取得“第”“条”中间的数字（这个是大写），然后查找下一段前七个字包括“第”“条”的，将“第”“条”中间的字符，改为取的上一个“第”“条”中间的数字+1。然后一直往下执行。
对VBA基本不太会，看能麻烦各位前辈有空指导下以下几点么？

1、从第一段开始，判断每段前七个字符是否包含“第”“条”。不能取全段包含，怕遇到段落中有“按第几条处理”的情况。
2、如果包含“第”“条”，则提取“第”“条”中间的数字，但是这是大写的，涉及到转换为小写的问题。
3、查找下一段前七个字符包含“第”“条”的，然后将“第”“条”中间的字符，改为提取的数字+1转换为大写的字符。
4、查找下一段，循环执行至结尾。

不胜感激！

zhanglei1371

可以了解下自动编号域。seq+Chinesenum3。可呈现大写。具体百度下，或论坛搜索下。

相见是缘8

给你一个 413191246se 老师的代码，运成试试，参考一下。

1. Sub test()
   
2.     Dim myRange As Range
   
3.     If Selection.Type = wdSelectionIP Then Selection.WholeStory
   
4.     Set myRange = Selection.Range
   
5.     myRange.Find.Execute findtext:="　", replacewith:="：", Replace:=wdReplaceAll
   
6.     myRange.Find.Execute findtext:="^w", replacewith:="", Replace:=wdReplaceAll
   
7.     Dim v As Long, i As Long
   
8.     Selection.HomeKey Unit:=wdStory
   
9.     Selection.Find.ClearFormatting
   
10.     Do While Selection.Find.Execute(findtext:="第", Forward:=True)
    
11.         Do  '外层循环运行。
    
12.             Selection.MoveEnd Unit:=wdCharacter, Count:=1
    
13.         Loop Until Selection Like "*[!一二三四五六七八九十百零]"
    
14.         If Selection Like "*条" Then
    
15.             Selection.MoveStart Unit:=wdCharacter, Count:=1
    
16.             Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
17.             Selection.Font.Color = wdColorRed
    
18.             If Selection Like "十[一二三四五六七八九]" Then
    
19.                 Selection.Characters(1) = "1"
    
20.                 Selection.MoveRight Unit:=wdCharacter, Count:=1
    
21.                 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
22.                 GoTo Sec
    
23.             ElseIf Selection Like "[一二三四五六七八九][十百]" Then
    
24.                 If Selection Like "*十" Then Selection.Characters(2) = "0" Else Selection.Characters(2) = "00"
    
25.                 Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
26.                 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
27.                 GoTo Sec
    
28.             ElseIf Selection Like "???十" Then
    
29.                 Selection.Characters.Last = "0"
    
30.             End If
    
31.             Selection = Replace(Selection, "百", "")
    
32.             If Len(Selection) >= 3 Then Selection = Replace(Selection, "十", "")
    
33.             v = Len(Selection)
    
34.             Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
35.             Do
    
36.                 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
37. Sec:
    
38.                 If Selection = "一" Then
    
39.                     Selection = "2"
    
40.                 ElseIf Selection = "二" Then
    
41.                     Selection = "3"
    
42.                 ElseIf Selection = "三" Then
    
43.                     Selection = "4"
    
44.                 ElseIf Selection = "四" Then
    
45.                     Selection = "5"
    
46.                 ElseIf Selection = "五" Then
    
47.                     Selection = "6"
    
48.                 ElseIf Selection = "六" Then
    
49.                     Selection = "7"
    
50.                 ElseIf Selection = "七" Then
    
51.                     Selection = "8"
    
52.                 ElseIf Selection = "八" Then
    
53.                     Selection = "9"
    
54.                 ElseIf Selection = "九" Then
    
55.                     Selection = "10"
    
56.                 ElseIf Selection = "十" Then
    
57.                     Selection = "11"
    
58.                 ElseIf Selection = "百" Then
    
59.                     Selection = "佰"
    
60.                 ElseIf Selection = "零" Then
    
61.                     Selection = "0"
    
62.                 End If
    
63.                 Selection.MoveRight Unit:=wdCharacter, Count:=1
    
64.                 i = i + 1
    
65.             Loop Until i = v
    
66.         End If
    
67.         Selection.MoveRight Unit:=wdCharacter, Count:=1
    
68.         i = 0
    
69.     Loop
    
70.     MsgBox "处理完毕！--下面请自行执行【第一章/条】宏完成第1条加粗任务！", vbOKOnly + vbExclamation, "第一条转第1条"
    
71. End Sub
    
72. 
    

复制代码

^天堂里的傻孩子

相见是缘8 发表于 2020-3-3 15:01
给你一个 413191246se 老师的代码，运成试试，参考一下。

试了下，直接用看来是不行的。
谢谢！

^天堂里的傻孩子

zhanglei1371 发表于 2020-3-3 12:11
可以了解下自动编号域。seq+Chinesenum3。可呈现大写。具体百度下，或论坛搜索下。

试了下，的确这个功能可以达到完全自动编号的功能，谢谢~
如果是完全自己做的应该没问题的，现在存在的问题，要改别人已经编号的第一条、第二条。

cuanju

Sub 批量将第X条改成汉字第n条1()
    iflag = 0
    With ActiveDocument.Content.Find
        .MatchWildcards = True
        .Text = "第X条"
        Do While .Execute
            Set oRng = .Parent
            oRng.Start = oRng.Start + 1
            oRng.End = oRng.End - 1
            iflag = iflag + 1
            oRng.Fields.Add Range:=oRng, Text:="= " & iflag & " \* CHINESENUM3"
            .Parent.Start = .Parent.End
        Loop
    End With
End Sub

^天堂里的傻孩子

cuanju 发表于 2020-3-3 17:04
Sub 批量将第X条改成汉字第n条1()
    iflag = 0
    With ActiveDocument.Content.Find

太谢谢了~实测可以用。
但是有一个问题还是存在，就是不是第X条开始的，比如有一段
第X条
（一）如果有XX情况，按第X条执行。
那么（一）后面这个第X条，也会被纳入排序。

^天堂里的傻孩子

cuanju 发表于 2020-3-3 17:04
Sub 批量将第X条改成汉字第n条1()
    iflag = 0
    With ActiveDocument.Content.Find

感觉需要添加触发的判断条件，“第”开头，而且在前7个字符内还有“条”。

cuanju

^天堂里的傻孩子 发表于 2020-3-3 18:59
感觉需要添加触发的判断条件，“第”开头，而且在前7个字符内还有“条”。

如果要改的“第X条”都在段首，则用以下代码。
============================
Sub d2()
    iflag = 0
    With ActiveDocument.Content.Find
        .MatchWildcards = True
        .Text = "^13第X条"
        Do While .Execute
            Set oRng = .Parent
            oRng.Start = oRng.Start + 2
            oRng.End = oRng.End - 1
            iflag = iflag + 1
            oRng.Fields.Add Range:=oRng, Text:="= " & iflag & " \* CHINESENUM3"
            .Parent.Start = .Parent.End
        Loop
    End With
End Sub

^天堂里的傻孩子

cuanju 发表于 2020-3-3 17:04
Sub 批量将第X条改成汉字第n条1()
    iflag = 0
    With ActiveDocument.Content.Find

还有一个问题，查找的不是  第X条，X是一个代表，可以是一二三十，一百一十一，等等。