2024年5月9日发(作者：)

Edition 1 能用1

Sub ChangeTextFont()

Set Pages =

pageCount =

'第一页和最后一页跳过

For i = 2 To pageCount - 1

DoEvents

ide Index:=i

shapeCount =

For j = 1 To shapeCount

(j).Select

shapeType = (j).Type

'1 - 自选图形

'7 - 公式

'13 - 图片

'14 - 占位符

'15 - 艺术字

'17 - 文本框

'19 - 表格

' shapeType

Select Case shapeType

Case 1, 14, 17

Set txtRange

nge

If <> "" Then

'设置字体为宋体, 24号

=

With

.Name = "宋体"

.Size = 24

End If

End With

'设置段落格式为1.3倍行距

With aphFormat

.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

For Each shp In

If tFrame Then

Set txtRng = nge

myColor = RGB(0, 0, 0) '颜色

= 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 <> ppSelectionText Then

MsgBox "请选中一个文本"

Exit Sub

End If

A =

'替换背景颜色为白色

'

'

RGB(255,255,255)

For Each slide In

For Each shape In

If tFrame Then

Set txt = nge

For Each sentence In ces

For Each Word In

'把蓝色的文字替换成灰色

=

If = A Then

With

. = 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

For Each oShape In

If tframe then

Set oTxtRange = nge

If Not IsNull(oTxtRange) Then

With

.Name = "楷体_GB2312" '更改为需要的字体

.Size = 15 '改为所需的文字大小

. = 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

' /* 遍历当前幻灯片中的形状对象. */

For Each shp In

' /* 当前幻灯片中的当前形状含有文本框架. */

If tFrame Then

' /* 当前幻灯片中的当前形状包含文本. */

If t Then

' 引用文本框架中的文本.

Set trng = nge

' /* 遍历文本框架中的每一个字符. */

For i = 1 To

' 这里请自行修改为原来的颜色值 (浅绿色).

If ters(i). = RGB(255, 120, 0) Then

' 这里请自行修改为要替换的颜色值 (深绿色).

ters(i). = vbBlue

End If

Next

End If

End If

Next

Next

End Sub