PPT_VBA例子.doc

Edition 1 能用1Sub 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 iEnd SubEdition 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 NextNextEnd SubEdition 3 能用3Sub 替换选定字体颜色为自动() 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 NextEnd Sub当然，发现有些字的颜色还是改不了。不知道什么原因。貌似知道什么原因了，edition 5可以用，edtion 5中用到的是character，也就是说那些不能改的汉字，ppt不当成word，而只是character，所以改不了。所以以后要改字体颜色或者字体大小，用character比较保险。Edition 4 能用4Sub 修改全文字体颜色()Dim oShape As ShapeDim oSlide As SlideDim oTxtRange As TextRangeOn Error Resume NextFor Each oSlide In ActivePresentation.Slides For Each oShape In oSlide.ShapesIf 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 IfEnd if NextNextEnd SubEdition 5 能用5Sub 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.C