这个代码，运行不了，请老师帮忙修改一下，谢谢！

相见是缘8

在网上找到这个代码，运行不了，请老师帮忙修改一下，谢谢！

Sub 选中指定查找的内容()
    Dim dw As Range
    Set dw = ActiveDocument.Content
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
        .Format = True
        .Font.Color = wdColorBlue  '字体颜色、蓝色
    With dw.Find
        .Text = "([!^13]{1,})卷([一二三四五六七八九十]{1,})："
        .Forward = False  '向上查找
        .MatchWildcards = True
        Do While .Execute = True
            dw.Editors.Add wdEditorEveryone
       Loop
    End With
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
End Sub

过客fppt

试试这个，注意在你要查找的文档中运行

1. 
   
2. sub 调用子程序查找()
   
3. Call 查找("([!^13]{1,})卷([一二三四五六七八九十]{1,})：", 1, 0)
   
4. end sub
   
5. Function 查找(文本, 通配符, 向下)
   
6. 
   
7.     Selection.Find.Font.Reset
   
8.     Selection.Find.ParagraphFormat.Reset
   
9.     With Selection.Find
   
10.         .Text = 文本
    
11.         .Forward = 向下
    
12.         .Wrap = wdFindContinue
    
13.         .MatchCase = True
    
14.         .MatchByte = True
    
15.         .MatchWildcards = 通配符
    
16.         .MatchWholeWord = False
    
17.         .MatchFuzzy = False
    
18.         .Replacement.Text = ""
    
19.     End With
    
20.     With Selection.Find
    
21.         .Style = ""
    
22.         .Highlight = wdUndefined
    
23.         With .Replacement
    
24.             .Style = ""
    
25.             .Highlight = wdUndefined
    
26.         End With
    
27.     End With
    
28.     Selection.Find.Execute Replace:=wdReplaceNone
    
29.     Selection.Find.Replacement.Text = ""
    
30.    
    
31.         Selection.Find.Font.Reset
    
32.     Selection.Find.ParagraphFormat.Reset
    
33. 
    
34. End Function
    

复制代码

zhgj007

这是个做什么用的？

过客fppt

zhgj007 发表于 2023-8-9 15:28
这是个做什么用的？

用来查找，用法有很多，比如一份物理题目当中可以的操作有：
1、可以用查找的方法自动统计出题目的总数
2、也可以用查找定位到题目序号的后面，批量给每道题目加入（多选）二字；
3、还可以定位到题目的起点和终点，或者答案的起点终点，从而识别出题干或答案区域，从而可以对题干或答案区域进行修改字体等操作

当然，想要实现上面的问题，每道题和答案格式必须统一

相见是缘8

过客fppt 发表于 2023-8-9 11:45
试试这个，注意在你要查找的文档中运行

过客fppt 老师好！

感谢帮助！

在我这运行不了，请见图。

相见是缘8

zhgj007 发表于 2023-8-9 15:28
这是个做什么用的？

zhgj007 老师好！
正如：过客fppt 老师说的，我这次是用来选中文档中，蓝色多个指定（含卷字）的不同内容，如：时方妙用、卷二：伤寒医诀串解、卷一十八：金匮方歌括、卷七：……等。

过客fppt

相见是缘8 发表于 2023-8-9 17:38
过客fppt 老师好！感谢帮助！在我这运行不了，请见图。

你好，我用的是WPS写的代码，和其他版本可能不同，你只要把出错的那一行删掉就好

相见是缘8

过客fppt 发表于 2023-8-9 17:57
你好，我用的是WPS写的代码，和其他版本可能不同，你只要把出错的那一行删掉就好

过客fppt 老师好！
好像不成，只查到一处，我那个一楼的代码，你有办法让它正常运行吗？

过客fppt

相见是缘8 发表于 2023-8-9 18:47
过客fppt 老师好！
好像不成，只查到一处，我那个一楼的代码，你有办法让它正常运行吗？

那你可以用for或者do循环：Call 查找("([!^13]{1,})卷([一二三四五六七八九十]{1,})：", 1, 0)
这样就可以查找到多处了

zhgj007

调整一下啊，在我这实验是成功的，你复制代码试一下。


Sub 选中指定查找的内容()
    Dim dw As Range
    Set dw = ActiveDocument.Content
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
      With dw.Find
  .Format = True
        .Font.Color = wdColorBlue  '字体颜色、蓝色
   
        .Text = "([!^13]{1,})卷([一二三四五六七八九十]{1,})："
        .Forward = False  '向上查找
        .MatchWildcards = True
        Do While .Execute = True
            dw.Editors.Add wdEditorEveryone
       Loop
    End With
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
End Sub