根据参考答案，标记出对应选项着色

深入学习SQL

求助：根据给出的参考答案，标记对应选项颜色。

详细参见附件。

413191246se

1. Sub a823_option()
   
2.     Dim s$
   
3.     With ActiveDocument.Content.Find
   
4.         .ClearFormatting
   
5.         .Text = "正确答案"
   
6.         .Forward = True
   
7.         .MatchWildcards = True
   
8.         Do While .Execute
   
9.             With .Parent
   
10.                 s = .Next
    
11.                 Do
    
12.                     .MoveStart 1, -1
    
13.                 Loop Until .Text Like s & "*"
    
14.                 .Characters(1).Select
    
15.                 With Selection
    
16.                     .MoveEnd
    
17.                     Do
    
18.                         .MoveEnd
    
19.                     Loop Until .Next.Text = " "
    
20.                     .Range.HighlightColorIndex = wdBrightGreen
    
21.                 End With
    
22.                 .Start = .End
    
23.             End With
    
24.         Loop
    
25.     End With
    
26. End Sub

复制代码

常扬帆

413191246se 发表于 2022-8-23 19:36

很好，谢谢！不过，我把“Green”改为“Red”似乎就不行了呢？

蜀中草莽

wdBrightGreen  改为 wdred

常扬帆

蜀中草莽 发表于 2022-8-24 09:57
wdBrightGreen  改为 wdred

OK，衷心感谢！

常扬帆

413191246se 发表于 2022-8-23 19:36

请问：如果是下面附件中的格式的话，怎么改？麻烦您了！

蜀中草莽

常扬帆 发表于 2022-8-24 10:48
请问：如果是下面附件中的格式的话，怎么改？麻烦您了！

不改代码得情况下，就把文档的格式 尽量靠近提问的文档，你这个 直接把正确答案后面的 冒号 替换掉就可以了

常扬帆

蜀中草莽 发表于 2022-8-24 15:31
不改代码得情况下，就把文档的格式 尽量靠近提问的文档，你这个 直接把正确答案后面的 冒号 替换掉就可以 ...

谢谢你的回答。不过文件太大，那么运行困难，想请高手改改代码。

413191246se

* 如果 楼主 使用 Word 2019 的话，请将代码拷贝到新建空白文档中，再全选、剪切，复制到 VBE 中执行。

1. Sub a824_option()
   
2.     Dim s$, r As Range
   
3.     With ActiveDocument
   
4.         .Content.Find.Execute "^l", , , 0, , , , , , "^p", 2
   
5.         Do While .Paragraphs.Last.Range.Text = vbCr
   
6.             .Paragraphs.Last.Range.Delete
   
7.         Loop
   
8.         Set r = .Content
   
9. sk:
   
10.         With r.Find
    
11.             .ClearFormatting
    
12.             .Text = "^13答案*^13"
    
13.             .Forward = False
    
14.             .MatchWildcards = True
    
15.             Do While .Execute
    
16.                 With .Parent
    
17.                     .MoveStart 1, 4
    
18.                     .MoveEnd 1, -1
    
19.                     If .Paragraphs.Count > 1 Then
    
20.                         .MoveEnd 4, -(.Paragraphs.Count - 1)
    
21.                         .MoveEnd 1, -1
    
22.                     End If
    
23.                     s = .Text
    
24.                     .Find.Execute s, , , , , , 0
    
25.                     .Expand 4
    
26.                     .HighlightColorIndex = wdBrightGreen
    
27.                     .End = .Start
    
28.                     .SetRange Start:=0, End:=.Start
    
29.                     GoTo sk
    
30.                 End With
    
31.             Loop
    
32.         End With
    
33.     End With
    
34.     Selection.HomeKey 6
    
35. End Sub

复制代码

413191246se

* 如果 相见是缘8 朋友看到此帖的话，我想借此楼说明一下：不是我不帮忙，实在是你的问题太难了！
* 需要像 sylun 老师 那样的高功夫水平的人才能解答，我现在越发认识到，我其实是录制宏的水平，连数组、函数、字典、正则等都不会用，一见到像 CreateObject 这样的函数就发懵……，根本读不懂代码。
* 抱歉啊！我一天上论坛好几遍，如果我能拿下来的小问题，必然出手；太难，实在是心有余而力不足。
* 我是热情无限，水平有限。会的有机会一定出手，不会的想出手也难（现在没想好算法）。