正则，运行时错误“424”

weiyingde

Sub 修改颜色字体()
    Dim reg As Object, i%, j%, mstr$
    Set reg = CreateObject("vbscript.regexp")
    For i = 2 To Sheets("临时整理").Range("a65536").End(3).Row
        Set Rng = Sheets("临时整理").Cells(i, "a")
        mstr = Rng.Text
        reg.Global = True
        reg.IgnoreCase = True
        reg.Pattern = "[A-Za-z]"
        For j = 0 To reg.Execute(mstr).Count - 1
            With Rng.Characters(reg.Execute(mstr)(j).firstindex + 1, 1).Font
                 .Color.RGB = RGB(0, 0, 255)
                 .NameFarEast = "楷体"
                 .NameAscii = "Arial Narrow"
            End With
        Next
    Next
    Set reg = Nothing
End Sub

weiyingde

附件如下，请查阅，谢谢。

weiyingde

再求大侠一看，指点一下。

huanglicheng

weiyingde 发表于 2017-3-14 20:13
再求大侠一看，指点一下。

在你的基础上小改一下

1. Sub 修改颜色字体()
   
2.     Dim reg As Object, i%, j%, mstr$
   
3.     Set reg = CreateObject("vbscript.regexp")
   
4.     For i = 2 To Sheets("临时整理").Range("a65536").End(3).Row
   
5.         Set Rng = Sheets("临时整理").Cells(i, "a")
   
6.         mstr = Rng.Text
   
7.         reg.Global = True
   
8.         reg.IgnoreCase = True
   
9.         reg.Pattern = "[A-Za-z]+"
   
10.         For j = 0 To reg.Execute(mstr).Count - 1
    
11.      
    
12.             With Rng.Characters(reg.Execute(mstr)(j).firstindex + 1, 1).Font
    
13.                     .Color = RGB(0, 0, 255)
    
14.                      .Name = "楷体"
    
15.             End With
    
16.         Next
    
17.     Next
    
18.     Set reg = Nothing
    
19.    
    
20. End Sub
    

复制代码

weiyingde

huanglicheng 发表于 2017-3-14 20:30
在你的基础上小改一下

谢谢你，但没有达到我要的效果，我要的效果是：
汉字是楷体，拼音是“方正姚体".具体见附件

liu-aguang

weiyingde 发表于 2017-3-14 20:56
谢谢你，但没有达到我要的效果，我要的效果是：
汉字是楷体，拼音是“方正姚体".具体见附件

1. Sub 修改颜色字体()
   
2.     Dim reg As Object, i%
   
3.     Set reg = CreateObject("vbscript.regexp")
   
4.     Sheets("临时整理").Range("a1").CurrentRegion.Font.Name = "楷体"
   
5.     For i = 2 To Sheets("临时整理").Range("a65536").End(3).Row
   
6.         Set Rng = Sheets("临时整理").Cells(i, "a")
   
7.         reg.Pattern = "\([^)]+"
   
8.         Set mh = reg.Execute(Rng.Text)
   
9.         If mh.Count <> 0 Then
   
10.             With Rng.Characters(mh(0).firstindex + 2, mh(0).Length - 1).Font
    
11.                  .ColorIndex = 3
    
12.                  .Size = 14
    
13.                  .Name = "方正舒体"
    
14.             End With
    
15.         End If
    
16.     Next
    
17.     Set reg = Nothing
    
18. End Sub
    

复制代码

weiyingde

liu-aguang 发表于 2017-3-14 21:16

很好，谢谢你，多次得到你的帮助，甚是感激。
佩服得多才多艺。

weiyingde

liu-aguang 发表于 2017-3-14 21:16

我试试能否在word中运用，如果不能的话，还要请教你。

weiyingde

liu-aguang 发表于 2017-3-14 21:16

在word 略做变通，有毛病，请看以下。
Sub 修改颜色字体()
    Dim reg As Object, i%
    Set reg = CreateObject("vbscript.regexp")
    For i = 2 To ActiveDocument.Paragraphs.Count
    ActiveDocument.Paragraphs(i).Range.Font.Name = "楷体"
    Next
    For j = 2 To ActiveDocument.Paragraphs.Count
        Set pg = ActiveDocument.Paragraphs(j).Range
        reg.Pattern = "\([^)]+"
        Set mh = reg.Execute(pg.Text)
        If mh.Count <> 0 Then
            With pg.Characters(mh(0).firstindex + 2, mh(0).Length - 1).Font
                 .ColorIndex = 3
                 .Size = 14
                 .Name = "方正姚体"
            End With
        End If
    Next
    Set reg = Nothing
End Sub

weiyingde

在此求救了，王大侠援手。