如何用代码实现横线下的效果

zzpsx

如何用代码实现横线下的效果.rar (10.83 KB, 下载次数: 11)

2020-7-28 19:06 上传

点击文件名下载附件

413191246se

* 请 楼主 自行删除不必要的空白段落，然后，如果不满意排序的结果，可以重新调入文档，再执行一次。

1. Sub test_查找下划线单词_随机排序()
   
2.     Dim n&, s$, x$, i&, r&, t$, arr, a As Range
   
3.     With ActiveDocument.Content.Find
   
4.         .ClearFormatting
   
5.         .Text = ""
   
6.         .Font.Underline = wdUnderlineSingle
   
7.         .Forward = True
   
8.         .MatchWildcards = True
   
9.         Do While .Execute
   
10.             n = n + 1
    
11.             With .Parent
    
12.                 s = s & " " & n & "." & .Text
    
13.                 x = x & "/" & .Text
    
14.                 If n = 1 Then .Select: Set a = Selection.Paragraphs(1).Range
    
15.             End With
    
16.         Loop
    
17.     End With
    
18. 
    
19.     ActiveDocument.Content.InsertAfter Text:=vbCr & "参考答案：" & s
    
20.     ActiveDocument.Paragraphs.Last.Range.Select
    
21.     Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
    
22.     Selection.TypeParagraph
    
23.     ActiveDocument.Paragraphs.Last.Range.Characters(6).Text = vbCr
    
24. 
    
25.     x = Right(x, Len(x) - 1)
    
26.     arr = Split(x, "/")
    
27. 
    
28.     Randomize
    
29.     For i = 0 To n - 1
    
30.         r = Int(Rnd * (n - i + 1)) + i
    
31.         If r = 5 Then Exit For
    
32.         t = arr(r)
    
33.         arr(r) = arr(i)
    
34.         arr(i) = t
    
35.     Next
    
36. 
    
37.     a.InsertBefore Text:=Join(arr, " ") & vbCr
    
38.     a.Paragraphs(1).Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
    
39.     Selection.HomeKey 6
    
40. End Sub
    

复制代码

jany1312

413191246se 发表于 2020-7-29 13:51
* 请 楼主 自行删除不必要的空白段落，然后，如果不满意排序的结果，可以重新调入文档，再执行一次。

厉害了我的哥，还是 会VBA 的厉害

idb

厉害了！！！

413191246se

楼主，你好！——我发现了一处错误！请将第 31 行代码：If r = 5 Then Exit For 中的“5” 修改为“n”，即：
If r = n Then Exit For
这样，就可以处理任意多个下线划单词了！5 显然是示例文档中的下划线单词数目。