替换括号内字体

mgh1111

例子：

一二三公司（原四五六部门）

明日（周五）上午半天接待，

广西陈三（男，45岁，已通知），其中3人已到达。

需求：将括号内的字体改为楷体，我通过宏录制的方法实现了

Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "（*）"

        .Replacement.Font.NameFarEast = "楷体"

        .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

但是，后来需求变化，并不是所有的括号都要改格式，比如（原四五六部门）就保留原格式不用变，这该怎么写呢？求助大神，诚挚感谢。

weiyingde

上附件，不然的话，工作量就大了。

daibao88

Sub test()
    With Selection.Find
        .Text = "[(（]*[)）]"
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = True
        .Replacement.Font.NameFarEast = "楷体"
        .Execute Replace:=wdReplaceAll
    End With
End Sub

daibao88

可能是半角、全角括号的事

mgh1111

附件在此，这样能看到吗

mgh1111

weiyingde 发表于 2020-2-11 20:23
上附件，不然的话，工作量就大了。

上附件啦，您看看

mgh1111

daibao88 发表于 2020-2-11 21:26
可能是半角、全角括号的事

我懂你的意思，[]里加入了半角和全角的考虑，但我还需要对内容做设定，比如text=”原四五六部门“时，即使在括号内，也不需要改变格式，就是一种例外的情况，这种逻辑不知道该怎么写呢，可以指导一下吗

daibao88

mgh1111 发表于 2020-2-12 15:10
我懂你的意思，[]里加入了半角和全角的考虑，但我还需要对内容做设定，比如text=”原四五六部门“时，即 ...

先查找替换（原四五六部门），记住匹配后的字体名称；
执行查找替换 ，替换字体
再先查找替换（原四五六部门），匹配后的字体名称=记住匹配后的字体名称；
vba代码基本一样，修改一下就行

mgh1111

daibao88 发表于 2020-2-12 16:58
先查找替换（原四五六部门），记住匹配后的字体名称；
执行查找替换 ，替换字体
再先查找替换（原四五 ...

（原四五六部门）在不同文档中字体不同，但都不需要改变原字体，这个怎么办

daibao88

Sub test()
    Dim fontn As String, myrg As range
    Set myrg = ActiveDocument.range
    With myrg.Find
        .Text = "[(（]原四五六部门[)）]"
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = True
        .Execute
        If .Found = True Then
            fontn = .Parent.Font.name
        End If
    End With
    Set myrg = ActiveDocument.range
    With myrg.Find
        .Text = "[(（]*[)）]"
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = True
        .Replacement.Font.NameFarEast = "楷体"
        .Execute Replace:=wdReplaceAll
    End With
    Set myrg = ActiveDocument.range
    With myrg.Find
        .Text = "[(（]原四五六部门[)）]"
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = True
        .Replacement.Font.name = fontn
        .Execute Replace:=wdReplaceAll
    End With
End Sub