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

相见是缘8

gbgbxgb 发表于 2019-8-6 14:07
。。。。。。。。。。。。。。

试试附件代码。

老师好！

谢谢老师你给的代码！不知为什么我在“附件”上运行代码后，序号没有改变，提示框提示如下图：

相见是缘8

413191246se 发表于 2019-8-6 10:56
* 魏老师：下面代码可以自定义题干部分字数；另外，像“8.9月……”这种情况，执行宏后可以校对一番。
*  ...

老师好！
同样感谢老师你给的代码！代码增加了一个判别多少字符参与编号的选项，这很人性化，像“8.9元钱……”这种类型的题目，判别难度可能较大，没法判别参与编号，虽然有点未达心愿，但我理解！

gbgbxgb

相见是缘8 发表于 2019-8-7 07:51
老师好！谢谢老师你给的代码！不知为什么我在“附件”上运行代码后，序号没有改变，提示框提示如下图：

我困惑你描述的情况。显然，代码运行了，但不是正确结果。我也不知道是什么原因造成的。

另外，我会错了你在早先楼层提的意思，即：想在看似编号的异常段落前添加序号。下面是你的原话：
如类似18楼提出的：“8.9元钱买的。99.9的含量。…”参与序号重排（就是在前面再加上序号）。


所以，我更新了附件中的代码。
请至原楼层重新下载附件试试看。

相见是缘8

gbgbxgb 发表于 2019-8-7 08:34
我困惑你描述的情况。显然，代码运行了，但不是正确结果。我也不知道是什么原因造成的。

另外，我会错 ...

老师好！
我重新下载了你29楼提供的“附件”，运行了“附件”内的代码，情况依旧，如我30楼提供的一样。老师、你哪边可正常重新编号吗？

gbgbxgb

相见是缘8 发表于 2019-8-7 09:06
老师好！
我重新下载了你29楼提供的“附件”，运行了“附件”内的代码，情况依旧，如我30楼提供的一样。 ...

真的好奇怪。正巧有一帖也反应我提供的附件代码运行没反应。

你试下载下列帖子我的附件看是否也没反应。
http://club.excelhome.net/thread-1491582-1-1.html

413191246se

* 相见 你好！——像“8.9元钱……”这种情况，你是希望参与编号，还是不希望参与编号呢？
* 但是，是否参与编号，我觉得，由使用者根据题干部分的字长来判断，与“元、月……”等关键词无关。
* 我觉得我的代码没有问题，因为可以自由输入不想要的段落长度，请重新认真运行一下我的宏（键入2）。

相见是缘8

gbgbxgb 发表于 2019-8-7 09:40
真的好奇怪。正巧有一帖也反应我提供的附件代码运行没反应。

你试下载下列帖子我的附件看是否也没反应 ...

老师好！
下载了你10楼提供的“附件”，运行了“附件”内的代码，运行不了。

相见是缘8

413191246se 发表于 2019-8-7 09:43
* 相见 你好！——像“8.9元钱……”这种情况，你是希望参与编号，还是不希望参与编号呢？
* 但是，是否参 ...

老师好！
我想像“8.9元钱买的。99.9的含量。…”这种类型的参与序号重排（也就是在前面再加上序号）。

413191246se

* 相见，请测试：

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

复制代码

leikaiyi123

网上下载的题有时题号前有空格