PPT_VBA例子

Edition 1能用1
Sub ChangeTextFont()
Set Pages = ActivePresentation.Slides.Range
pageCount = Pages.Count
'第一页和最后一页跳过
For i = 2 To pageCount - 1
DoEvents
ActiveWindow.View.GotoSlide Index:=i
shapeCount = ActiveWindow.Selection.SlideRange.Shapes.Count
For j = 1 To shapeCount
ActiveWindow.Selection.SlideRange.Shapes(j).Select
shapeType = ActiveWindow.Selection.SlideRange.Shapes(j).Type
'1 -自选图形
'7 -公式
'13 -图片
'14 -占位符
'15 -艺术字
'17 -文本框
'19 -表格
'Debug.Print shapeType
Select Case shapeType
Case 1, 14, 17
Set txtRange = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange
txtRange.Select
If txtRange.Text <> "" Then
'设置字体为宋体, 24号
With txtRange.Font
.Name = "宋体"
.Size = 24
End If
End With
'设置段落格式为1.3倍行距
With txtRange.ParagraphFormat
.SpaceWithin = 1.3
End With
End If
Case 7, 13, 15
Case 19
End Select
Next j
Next i
End Sub
Edition 2能用2
'改变所有文本框的字体颜色为黑色
Sub Macro1()
For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
myColor = RGB(0, 0, 0) '颜色
txtRng.Font.Color.RGB = myColor
End If
Next
Next
End Sub
Edition 3能用3
Sub 替换选定字体颜色为自动()
Dim A As Long
Dim shape As shape
Dim slide As slide
Dim txt As TextRange
'On Error Resume Next
'A = InputBox("请选择要替换的颜色")
If ActiveWindow.Selection.Type <> ppSelectionText Then
MsgBox "请选中一个文本"
Exit Sub
End If
A = ActiveWindow.Selection.TextRange.Font.Color.RGB
'替换背景颜色为白色
'ActivePresentation.SlideMaster.Background.Fill.Solid
'ActivePresentation.SlideMaster.Background.Fill.ForeColor.RGB = RGB(255,255,255) For Each slide In ActivePresentation.Slides
For Each shape In slide.Shapes
If shape.HasTextFrame Then
Set txt = shape.TextFrame.TextRange
For Each sentence In txt.Sentences
For Each Word In sentence.Words
'把蓝色的文字替换成灰色
If Word.Font.Color.RGB = A Then
With Word.Font
.Color.RGB = RGB(40, 40, 40)
End With
End If
Next
Next
End If
Next
Next
End Sub
当然，发现有些字的颜色还是改不了。

不知道什么原因。

貌似知道什么原因了，edition 5可以用，edtion 5中用到的是character，也就是说那些不能改的汉字，ppt不当成word，而只是character，所以改不了。

所以以后要改字体颜色或者字体大小，用character比较保险。

Edition 4能用4
Sub 修改全文字体颜色()
Dim oShape As Shape
Dim oSlide As Slide
Dim oTxtRange As TextRange
On Error Resume Next
For Each oSlide In ActivePresentation.Slides
For Each oShape In oSlide.Shapes
If oShape.HasTextframe then
Set oTxtRange = oShape.TextFrame.TextRange
If Not IsNull(oTxtRange) Then
With oTxtRange.Font
.Name = "楷体_GB2312" '更改为需要的字体
.Size = 15 '改为所需的文字大小
.Color.RGB = RGB(Red:=255, Green:=120, Blue:=0) '改成想要的文字颜色，用RGB参数表示
End With
End If
End if
Next
Next
End Sub
Edition 5能用5
Sub Demo()
Dim s As slide
Dim shp As shape
Dim trng As TextRange
Dim i As Integer
' /* 遍历活动窗口中打开的演示文稿中的幻灯片. */
For Each s In ActivePresentation.Slides
' /* 遍历当前幻灯片中的形状对象. */
For Each shp In s.Shapes
' /* 当前幻灯片中的当前形状含有文本框架. */
If shp.HasTextFrame Then
' /* 当前幻灯片中的当前形状包含文本. */
If shp.TextFrame.HasText Then
' 引用文本框架中的文本.
Set trng = shp.TextFrame.TextRange
' /* 遍历文本框架中的每一个字符. */
For i = 1 To trng.Characters.Count
' 这里请自行修改为原来的颜色值(浅绿色).
If trng.Characters(i).Font.Color = RGB(255, 120, 0) Then
' 这里请自行修改为要替换的颜色值(深绿色).
trng.Characters(i).Font.Color = vbBlue
End If
Next
End If
End If
Next
Next
End Sub。