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 <> \ '设置字体为宋体, 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

本文来源：https://www.bwwdw.com/article/f1uh.html