优化：蜗牛快些走！请大侠斧正正则代码。

weiyingde

Sub 修改西文字1()
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.IgnoreCase = True
t = Timer
reg.Pattern = "[A-Za-z]"
For Each sld In ActivePresentation.Slides
   For Each shp In sld.Shapes
       If shp.HasTextFrame Then
          If shp.TextFrame.HasText Then
                trng = shp.TextFrame.TextRange.Text
                For j = 1 To reg.Execute(trng).Count - 1
                    With shp.TextFrame.TextRange.Characters(reg.Execute(trng)(j).firstindex + 1).Font
                         .Size = 20
                         .Color.RGB = vbYellow
                         .Italic = msoCTrue
                         .NameAscii = "方正姚体"
                     End With
                 Next
            End If
        End If
    Next
Next
MsgBox (Timer - t) & "秒"
End Sub

weiyingde

遍历文本框、表格和组合，居然还有些西文字体不受控制。代码如下，请大虾斧正：
Sub 修改西文字1()
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.IgnoreCase = True
t = Timer
reg.Pattern = "[A-Za-z]" 'A-Za-z'[一-隝]龢
For Each sld In ActivePresentation.Slides
   For Each shp In sld.Shapes
       If shp.HasTextFrame Then
          If shp.TextFrame.HasText Then
                trng = shp.TextFrame.TextRange.Text
                istr = Replace(trng, Chr(7), "")
                 For j = 1 To reg.Execute(istr).Count - 1
                    With shp.TextFrame.TextRange.Characters(reg.Execute(istr)(j).firstindex + 1).Font
                         .Size = 20
                         .Color.RGB = vbRed
                         .Italic = msoCTrue
                         .NameAscii = "方正姚体"
                   End With
                 Next
          End If
          If shp.HasTable Then
             With shp.Table
               r = .Rows.Count
               c = .Columns.Count
               For x = 1 To r
                  For y = 1 To c
                  rg = .Table.Cell(x, y).Shape.TextFrame.TextRange.Text
                     For i = 1 To reg.Execute(rg).Count - 1
                         With shp.TextFrame.TextRange.Characters(reg.Execute(rg)(i).firstindex + 1).Font
                           .Size = 25
                           .Color.RGB = vbGreen
                           .Italic = False
                           .NameAscii = "Arial"
                           .Name = "Arial"
                         End With
                     Next
                  Next
                Next
              End With
           End If
           If InStr(shp.Name, "Group") > 0 Then
                For i = 1 To shp.GroupItems.Count
                    If shp.GroupItems(i).HasTextFrame Then
                        If shp.GroupItems(i).TextFrame.HasText Then
                             rng = shp.GroupItems(ii).TextFrame.TextRange.Text
                             For ii = 1 To reg.Execute(rng).Count - 1
                             With shp.TextFrame.TextRange.Characters(reg.Execute(rng)(ii).firstindex + 1).Font
                                .Size = 25
                                .Color.RGB = vbGreen
                                .Italic = False
                                .NameAscii = "Arial"
                                .Name = "Arial"
                             End With
                             Next
                        End If
                    End If
                Next
           End If
       End If
    Next
Next
MsgBox (Timer - t) & "秒"
End Sub

weiyingde

有人路过吗？希望援手一助！！谢谢