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