一次性修改所有ppt页面中字体的颜色和大小

Sub 一次性修改所有ppt页面中字体的颜色和大小()
For i = 1 To ActiveWindow.Selection.SlideRange.SlideNumber
num = ActiveWindow.Selection.SlideRange.Shapes.Count
If i = ActiveWindow.Selection.SlideRange.SlideNumber Then
num = num - 1
End If
For j = 1 To num
ActiveWindow.View.GotoSlide Index:=i
aaa = ActiveWindow.Selection.SlideRange.Shapes(j).Name
If InStr(1, aaa, "text box") > 0 Then
ActiveWindow.Selection.SlideRange.Shapes(j).Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Size = 20 '改成你想要的字体大小
ActiveWindow.Selection.TextRange.Font.Color.RGB = RGB(Red:=10, Green:=250, Blue:=250) '改成你想要的字体颜色
End If
If InStr(1, aaa, "Rectangle") > 0 Then
ActiveWindow.Selection.SlideRange.Shapes(j).Select
ActiveWindow.Selection.TextRange.Font.Size = 20       '改成你想要的字体大小
ActiveWindow.Selection.TextRange.Font.Color.RGB = RGB(Red:=255, Green:=0, Blue:=250) '改成你想要的字体颜色
End If
Next j
Next i
End Sub
上面的程序只能修改当前页面中占位符中的，但不能修改PPT表格或组合文本框中的字体大小和颜色。

Sub myfont()
Dim oShape As Shape
Dim oSlide As Slide
Dim oTxtRange As TextRange
On Error Resume Next    '之后的代码就算出错也会继续执行
For Each oSlide In ActivePresentation.Slides
oSlide.FollowMasterBackground = msoTrue '使用幻灯片母版背景
For Each oShape In oSlide.Shapes
         '文本框字体设置
With oShape.TextFrame.TextRange.Font
           .Name = "宋体"
           .Size = 20
            .Color.RGB = RGB(Red:=250, Green:=0, Blue:=0)
           .Bold = msoFalse '粗
            .Italic = msoFalse '斜
             .Underline = msoFalse '下划线
End With
oShape.Fill.Background '文本框背景色用幻灯背景填充
oShape.TextFrame.TextRange.IndentLevel = 0
        '表格字体设置
'oShape.Table.Background.Fill.BackColor.RGB = RGB(Red:=255, Green:=255, Blue:=255) '底色
For i = 1 To oShape.Table.Rows.Count
For j = 1 To oShape.Table.Columns.Count
oShape.Table.Cell(i, j).Shape.Fill.BackColor.RGB = RGB(Red:=250, Green:=0, Blue:=0)
With oShape.Table.Cell(i, j).Shape.TextFrame.TextRange.Font
.Name = "宋体"
.Size = 20
.Color.RGB = RGB(Red:=250, Green:=0, Blue:=0)
.Bold = msoFalse '粗
.Italic = msoFalse '斜
.Underline = msoFalse '下划线
End With
Next j
Next i
Next
Next
End Sub
但不能对组合文本框进行设置

[ 本帖最后由 chuhaiou 于 2011-3-1 09:10 编辑 ]