正则，运行时错误“424”

weiyingde

没关系，有时间看看，不急，没时间我就在EXcel上实现，再在word上整理。

duquancai

weiyingde 发表于 2017-3-16 10:17
附件如下，请接收。谢谢。

Sub W_移形换位()
    Dim reg As Object, mt, mh, oDOC As Document
    Set oDOC = ActiveDocument
    With oDOC.Content.Find
        .Execute "([\(（])^32{1,}", , , 1, , , , , , "\1", 2
        .Execute "^32{1,}([\)）])", , , 1, , , , , , "\1", 2
        .Execute "^32{1,}", , , 1, , , , , , "^32", 2
    End With
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True: reg.Pattern = "[\(（][^）\)]+[\)）]"
    For Each mt In reg.Execute(oDOC.Content)
        m = mt.FirstIndex: n = mt.Length
        With oDOC.Range(m, m + n)
            reg.Pattern = " ": t = reg.Execute(.Text).Count + 1
            .Start = .Start - t
            .Find.Execute "([一-﨩]{" & t & "})([\(（])(*)([\)）])", , , 1, , , , , , "\3\2\1\4", 1
            reg.Pattern = "[\(（][^）\)]+[\)）]"
            For Each mh In reg.Execute(.Text)
                f = mh.FirstIndex: l = mh.Length
                With oDOC.Range(.Start + f, .Start + f + l)
                    .Start = .Start + 1: .End = .End - 1
                    .Font.Color = RGB(255, 255, 255)
                End With
            Next
        End With
    Next
End Sub

weiyingde

太好了，谢谢，谢谢，谢谢！！！
辛苦你了，代码非常好用！！
大侠正则用的出神入化，佩服佩服！！
有时间好好跟你学学正则，怕到时候大侠嫌弃本人的愚笨不肯赐教！！

weiyingde

duquancai 发表于 2017-3-16 20:34
Sub W_移形换位()
    Dim reg As Object, mt, mh, oDOC As Document
    Set oDOC = ActiveDocument

若有时间，能否给表达式的代码语句加个注释？

weiyingde

duquancai 发表于 2017-3-15 20:39
满足你的要求，用正则，这个速度就快得多！！！

Sub W_正则()

这个美中不足的是：
把夹在拼音中的汉字的颜色也给变了。如：
广袤(mào)无垠(yín)
“无垠”的颜色和拼音的颜色一致了。
请大虾测试一下。

duquancai

不测试了，我过程名就是移形换位，知道有这情况。颜色的问题不是难事，但是不想再搞你这玩意了。

weiyingde

duquancai 发表于 2017-3-17 17:29
不测试了，我过程名就是移形换位，知道有这情况。颜色的问题不是难事，但是不想再搞你这玩意了。

不好意思，前前后花费了你的不少时间……
我只是说说，也不好意思苛求你了。

weiyingde

duquancai 发表于 2017-3-17 17:29
不测试了，我过程名就是移形换位，知道有这情况。颜色的问题不是难事，但是不想再搞你这玩意了。

还是厚着脸问你，若有时间，帮我简化，那就大喜过望了。
目的是：
将")"和“("的字体改为"方正姚体"、蓝色；
将之间的汉字改为“楷体"、黑色。
问题：代码自我感觉啰嗦。
能帮我简化了。
Sub 转中间汉字为黑色()
Dim regx As Object, mth
Set regx = CreateObject("vbscript.regexp")
    regx.Global = True
    regx.Pattern = "(\)[一-﨩]+\()"
    For Each mth In regx.Execute(ActiveDocument.Content)
        k = mth.FirstIndex: c = mth.Length
        With ActiveDocument.Range(k, k + c)
            .Font.Name = "楷体" '"楷体"
            .Start = .Start + 1
            .End = .End - 1
            .Font.ColorIndex = 1 '1,黑色；2，蓝色；3，天兰；4，绿色；5，红色；6，红色；7，黄色；8，白色
        End With
        With ActiveDocument.Range(k, k + c).Characters(1)
            .Font.Name = "方正姚体"
            .Font.ColorIndex = 2
        End With
        With ActiveDocument.Range(k, k + c).Characters(c)
            .Font.Name = "方正姚体"
            .Font.ColorIndex = 2
        End With
    Next
End Sub

duquancai

weiyingde 发表于 2017-3-18 20:56
还是厚着脸问你，若有时间，帮我简化，那就大喜过望了。
目的是：
将")"和“("的字体改为"方正姚体"、 ...

Sub shishi()
    With ActiveDocument.Content.Find
        Do While .Execute("[）\)][一-﨩]@[\(（]", , , 1)
            t = Len(.Parent.Text)
            With .Parent
                .Collapse: .End = .End + 1: .Font.Name = "方正姚体": .Font.ColorIndex = 2
                .Collapse 0: .End = .End + t - 2: .Font.Name = "楷体": .Font.ColorIndex = 1
                .Collapse 0: .End = .End + 1: .Font.Name = "方正姚体": .Font.ColorIndex = 2
                .Collapse 0
            End With
        Loop
    End With
End Sub

weiyingde

duquancai 发表于 2017-3-18 21:33
Sub shishi()
    With ActiveDocument.Content.Find
        Do While .Execute("[）\)][一-﨩]@[\(（ ...

不愧大侠，还有个问题和大侠讨教：
你的32楼代码，我在关键代码中删掉了一些“（”和“）”也能实现相同的效果，能解释一下吗：
以下红色的部分是我删掉的：
Sub W_移形换位()
    Dim reg As Object, mt, mh, oDOC As Document
    Set oDOC = ActiveDocument
    With oDOC.Content.Find
        .Execute "([\(（])^32{1,}", , , 1, , , , , , "\1", 2
        .Execute "^32{1,}([\)）])", , , 1, , , , , , "\1", 2
        .Execute "^32{1,}", , , 1, , , , , , "^32", 2
    End With
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True: reg.Pattern = "[\(（][^）\)]+[\)）]"
    For Each mt In reg.Execute(oDOC.Content)
        m = mt.FirstIndex: n = mt.Length
        With oDOC.Range(m, m + n)
            reg.Pattern = " ": t = reg.Execute(.Text).Count + 1
            .Start = .Start - t
            .Find.Execute "([一-﨩]{" & t & "})([\(（])(*)([\)）])", , , 1, , , , , , "\3\2\1\4", 1
            reg.Pattern = "[\(（][^）\)]+[\)）]"
            For Each mh In reg.Execute(.Text)
                f = mh.FirstIndex: l = mh.Length
                With oDOC.Range(.Start + f, .Start + f + l)
                    .Start = .Start + 1: .End = .End - 1
                    .Font.Color = RGB(255, 255, 255)
                End With
            Next
        End With
    Next
End Sub