PPT_VBA例子讲解学习.docx

《PPT_VBA例子讲解学习.docx》由会员上传分享，免费在线阅读，更多相关内容在教育资源-天天文库。

1、Edition1能用1SubChangeTextFont()SetPages=ActivePresentation.Slides.RangepageCount=Pages.Count'第一页和最后一页跳过Fori=2TopageCount-1DoEventsActiveWindow.View.GotoSlideIndex:=ishapeCount=ActiveWindow.Selection.SlideRange.Shapes.CountForj=1ToshapeCountActiveWindow.Selection.SlideRange.

2、Shapes(j).SelectshapeType=ActiveWindow.Selection.SlideRange.Shapes(j).Type'1-自选图形'7-公式'13-图片'14-占位符'15-艺术字'17-文本框'19-表格'Debug.PrintshapeTypeSelectCaseshapeTypeCase1,14,17SettxtRange=ActiveWindow.Selection.ShapeRange.TextFrame.TextRangetxtRange.SelectIftxtRange.Text<>""Then

3、'设置字体为宋体,24号WithtxtRange.Font.Name="宋体".Size=24EndIfEndWith'设置段落格式为1.3倍行距WithtxtRange.ParagraphFormat.SpaceWithin=1.3EndWithEndIfCase7,13,15Case19EndSelectNextjNextiEndSubEdition1能用2'改变所有文本框的字体颜色为黑色SubMacro1()ForEachsldInApplication.ActivePresentation.SlidesForEachshpInsld

4、.ShapesIfshp.HasTextFrameThenSettxtRng=shp.TextFrame.TextRangemyColor=RGB(0,0,0)'颜色txtRng.Font.Color.RGB=myColorEndIfNextNextEndSubEdition2能用3Sub替换选定字体颜色为自动()DimAAsLongDimshapeAsshapeDimslideAsslideDimtxtAsTextRange'OnErrorResumeNext'A=InputBox("请选择要替换的颜色")IfActiveWindow.S

5、election.Type<>ppSelectionTextThenMsgBox"请选中一个文本"ExitSubEndIfA=ActiveWindow.Selection.TextRange.Font.Color.RGB'替换背景颜色为白色'ActivePresentation.SlideMaster.Background.Fill.Solid'ActivePresentation.SlideMaster.Background.Fill.ForeColor.RGB=RGB(255,255,255)ForEachslideInActivePr

6、esentation.SlidesForEachshapeInslide.ShapesIfshape.HasTextFrameThenSettxt=shape.TextFrame.TextRangeForEachsentenceIntxt.SentencesForEachWordInsentence.Words'把蓝色的文字替换成灰色IfWord.Font.Color.RGB=AThenWithWord.Font.Color.RGB=RGB(40,40,40)EndWithEndIfNextNextEndIfNextNextEndSub当然

7、，发现有些字的颜色还是改不了。不知道什么原因。貌似知道什么原因了，edition5可以用，edtion5中用到的是character，也就是说那些不能改的汉字，ppt不当成word，而只是character，所以改不了。所以以后要改字体颜色或者字体大小，用character比较保险。Edition1能用4Sub修改全文字体颜色() DimoShapeAsShape DimoSlideAsSlide DimoTxtRangeAsTextRange OnErrorResumeNext ForEachoSlideInActivePresentat

8、ion.Slides   ForEachoShapeInoSlide.ShapesIfoShape.HasTextframethen     SetoTxtRange=oShap