ndsy415 发表于 2017-4-10 10:23:43

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

Sub 修改西文字1()
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.IgnoreCase = True
t = Timer
reg.Pattern = ""
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

asdf1001 发表于 2017-4-10 11:37:57

遍历文本框、表格和组合，居然还有些西文字体不受控制。代码如下，请大虾斧正：
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
                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

yamede 发表于 2017-4-10 12:06:37

有人路过吗？希望援手一助！！谢谢
页: [1]
查看完整版本: 优化：蜗牛快些走！请大侠斧正正则代码。