怪事：用得好好的一段程序，今天发现不灵

413191246se

* wdpfox 说得好！ 如果不是“元”，而是“月”呢？
* 魏老师，虽然 gbgbxgb 老师 给您讲了一大堆 VBA 方法，但我不得不说，您可能没认真学习过 VBA 微软官方帮助文档。因为在那个文档中，".MoveEnd"方法在举例中出现过多次，我注意到了，然后会了这个方法，顺便也会了 ".MoveStart"方法，受益匪浅！
* 如果 魏老师 掌握了 “.MoveEnd”、“.MoveStart” 这两个方法，这个帖子的问题根本就不算什么问题。
* 魏老师，我建议您，最好有时间把《VBA 微软官方帮助》这个 CHM 文档认真地学习一下，相信会有很大的收获（如果没有，可到我的《Word2003 & 2007 VBA 自动排版宏（集成版）2019-7-9》帖子中点击下载链接下载此文档（空题号问题，我建议：全选，加大段前/段后间距比如30磅，不保存，只记录空题号）。

weiyingde

wdpfox 发表于 2019-8-5 23:09
^13[0-9]{1,}[.、．][!0-9^13]排除以小数开头的段落，如“8.9元钱买的……  ”

这是可以的。

weiyingde

wdpfox 发表于 2019-8-5 23:12
还是感觉有“ 坑 ”

你的感觉不是多余的。
这可能会查找不连续的文本。比如：
14.今天我买了14.5公斤梨子。
红色的部分即是，这会给后续的处理带来麻烦。

weiyingde

413191246se 发表于 2019-8-5 19:11
* 呵呵！ 我挑 魏老师 一句！“解决这个问题还是得你用的。”
* 虽然 gbgbxgb 老师，现在我才认识到非常厉 ...

好的，感谢你了。你对word VBA是非常熟悉的，多向你请教。
先说一声：辛苦了！

相见是缘8

gbgbxgb 发表于 2019-8-5 17:03
只要如下即可：
Sub 重编序号()
    Dim n&

老师好！

如类似18楼提出的：“8.9元钱买的。99.9的含量。…”参与序号重排（就是在前面再加上序号）。

如类似15楼提出的：如光有一个题号而后面没有题目的，空题号删除。

想请老师改一下代码，从第一个序号开始重排，谢谢！

相见是缘8

413191246se 发表于 2019-8-5 19:11
* 呵呵！ 我挑 魏老师 一句！“解决这个问题还是得你用的。”
* 虽然 gbgbxgb 老师，现在我才认识到非常厉 ...

老师好！

如类似18楼提出的：“8.9元钱买的。99.9的含量。…”参与序号重排（就是在前面再加上序号）。

如类似15楼提出的：如光有一个题号而后面没有题目的，空题号删除。

想请老师改一下代码，从第一个序号开始重排，谢谢！

413191246se

* 魏老师：下面代码可以自定义题干部分字数；另外，像“8.9月……”这种情况，执行宏后可以校对一番。
* 校对后，可以重新应用本宏，重新编号。请处理前备份原文档。

1. Sub aaab题号自动编号()
   
2.     Dim n&, v&, x$
   
3.     x = InputBox("请问：题干多少字以下不编号？（默认20字以下）", "题号自动编号", "20")
   
4.     If x = "" Then Exit Sub
   
5.     With ActiveDocument
   
6.         '回车符/手动换行符=>段落标记
   
7.         .Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2
   
8.         '删除域
   
9.         .Fields.Unlink
   
10.         '列表编号/LISTNUM域转文本
    
11.         .ConvertNumbersToText
    
12.         '文首插入段落标记
    
13.         .Content.InsertBefore Text:=vbCr
    
14.         '全文设置为自动色
    
15.         .Content.Font.Color = wdColorAutomatic
    
16.         With ActiveDocument.Content.Find
    
17.             .ClearFormatting
    
18.             .Text = "^13[0-9０-９]{1,}[.．、]"
    
19.             .Forward = True
    
20.             .MatchWildcards = True
    
21.             Do While .Execute
    
22.                 With .Parent
    
23.                     .MoveStart
    
24.                     v = Len(.Paragraphs(1).Range) - Len(.Text) - 1
    
25.                     If v >= x Then
    
26.                         n = n + 1
    
27.                         .Text = n & "．"
    
28.                         With .Font
    
29.                             .Name = "Times New Roman"
    
30.                             .Bold = True
    
31.                             .Color = wdColorGreen '绿色
    
32.                         End With
    
33.                         .Characters.Last.Font.NameFarEast = "宋体"
    
34.                     Else
    
35.                         .Paragraphs(1).Range.Font.Color = wdColorRed '红色
    
36.                         .Paragraphs(1).Range.Font.Underline = wdUnderlineWavyHeavy '重波浪线
    
37.                     End If
    
38.                     .Start = .End
    
39.                 End With
    
40.             Loop
    
41.         End With
    
42.         .Paragraphs.First.Range.Delete
    
43.     End With
    
44. '''
    
45. '经典代码_循环遍历段落法_ForEachNext
    
46.     If MsgBox("是否删除红色/重波浪线段落？", 4 + 16) = vbNo Then End
    
47.     Dim i As Paragraph
    
48.     For Each i In ActiveDocument.Paragraphs
    
49.         If i.Range.Font.Color = wdColorRed Then i.Range.Delete
    
50.     Next
    
51. End Sub

复制代码

gbgbxgb

相见是缘8 发表于 2019-8-6 08:50
老师好！如类似18楼提出的：“8.9元钱买的。99.9的含量。…”参与序号重排（就是在前面再加上序号）。如 ...

奇怪，无法跟帖。

413191246se

相见是缘 你好！ 像“8.9元钱……”这种类型的题目，没法确定，我认为。如果程序认定是题目，编号后也要人工校对，只能说，这样的题目，出错了！ 试卷题目必须人工校对后，再用程序自动编号就好了；没有校对，无法判断。

gbgbxgb

相见是缘8 发表于 2019-8-6 08:50
老师好！如类似18楼提出的：“8.9元钱买的。99.9的含量。…”参与序号重排（就是在前面再加上序号）。如 ...

。。。。。。。。。。。。。。

试试附件代码。