正则替换如何限定字体？用录制宏没法指定字体？

xkqtdzj

下面是我操作的正则替换：


(*)([^13。])（说明：要指定是黑体）

〖HTH〗\1〖HT〗\2

(*)([^13。])（说明：要指定是楷体）

〖HTK〗\1〖HT〗\2


这个如何用VBA实现？
我录制宏的时候，限制字体的操作好象录制不了。

413191246se

楼主，你有什么具体的要求？最好提供附件上来，不用正则，用 VBA 也能解决。

小花鹿

不对啊，查找替换可以限定字体的                                                                                       

xkqtdzj

谢谢413191246se一直以来的帮助。
这个需求是这样的：在指定的字体的字符串或段落前后插入自定义的字符。
不知这样我说明白了没？
@小花鹿　手动没问题，我录制宏的时候，代码里没有指定字体的内容。是我录制时有什么操作不对的地方？

见附件可以明白我的意思，一个文档是正则替换前的，一个文档是正则替换后的。
我希望用VBA来实现这个操作。

413191246se

楼主，附件下载损坏，我试着编了一个小宏，看看是否满意：

1. Sub aa查找黑体_前后插入指定字符()
   
2. '全文查找：不激活对象/不选定文字内容/查找后光标不动/速度极快
   
3.     With ActiveDocument.Content.Find
   
4.         .ClearFormatting
   
5.         .Font.NameFarEast = "黑体"
   
6.         .Forward = True
   
7.         .MatchWildcards = True
   
8.         Do While .Execute
   
9.             With .Parent
   
10.                 .InsertBefore Text:="【"
    
11.                 .InsertAfter Text:="】"
    
12.                 .Font.Color = wdColorRed '红色（本行代码可删除）
    
13.                 .Start = .End
    
14.             End With
    
15.         Loop
    
16.     End With
    
17. End Sub

复制代码

xkqtdzj

谢谢413191246se帮助，提供的代码可以达到我的希望。细化一下就OK了！

我尝试录制宏，然后在宏代码中指定字体。可以用了。
Sub 插入注解H()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(*)([^13。：])"
        .Font.NameFarEast = "黑体"
        .Replacement.Text = "〖HTH〗\1〖HT〗\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub 插入注解K()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(*)([^13。：])"
        .Font.NameFarEast = "楷体"
        .Replacement.Text = "〖HTK〗\1〖HT〗\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

413191246se

楼主，厉害！用替换就完成了！我给你的代码精简了一下：

1. Sub 插入注解H_OK()
   
2.     With Selection
   
3.         .HomeKey Unit:=wdStory
   
4.         With .Find
   
5.             .ClearFormatting
   
6.             .Text = "(*)([^13。：])"
   
7.             .Font.NameFarEast = "黑体"
   
8.             With .Replacement
   
9.                 .ClearFormatting
   
10.                 .Text = "〖HTH〗\1〖HT〗\2"
    
11.             End With
    
12.             .Execute MatchWildcards:=True, Forward:=True, Format:=True, Replace:=wdReplaceAll
    
13.         End With
    
14.     End With
    
15. End Sub
    
16. Sub 插入注解K_OK()
    
17.     With Selection
    
18.         .HomeKey Unit:=wdStory
    
19.         With .Find
    
20.             .ClearFormatting
    
21.             .Text = "(*)([^13。：])"
    
22.             .Font.NameFarEast = "楷体"
    
23.             With .Replacement
    
24.                 .ClearFormatting
    
25.                 .Text = "〖HTK〗\1〖HT〗\2"
    
26.             End With
    
27.             .Execute MatchWildcards:=True, Forward:=True, Format:=True, Replace:=wdReplaceAll
    
28.         End With
    
29.     End With
    
30. End Sub

复制代码

xkqtdzj

413191246se 发表于 2019-6-21 14:07
楼主，厉害！用替换就完成了！我给你的代码精简了一下：

谢谢413191246se，这样去除冗余，重点突出了。