PowerPoint VBA (Macros) 教程

另存为宏功能演示文稿

带有VBA代码的演示文稿应该 “保存为 “PowerPoint支持宏的演示文稿(*.pptm)

启用功能区中的 “开发人员 “选项卡

在创建VBA代码之前，你应该在Ribbon中启用 “开发者 “选项卡。要做到这一点，请选择 “文件 -> 选项”，然后点击 “自定义功能区”，并在右侧窗格中勾选 “开发人员 “选项卡旁边的方框。

启用“开发人员”选项卡创建PowerPoint宏

这是一个简单的PowerPoint VBA宏的例子。

Sub SavePresentationAsPDF() Dim pptName As String Dim PDFName As String ‘ Save PowerPoint as PDF pptName = ActivePresentation.FullName ‘ Replace PowerPoint file extension in the name to PDF PDFName = Left(pptName, InStr(pptName, “.”)) & “pdf” ActivePresentation.ExportAsFixedFormat PDFName, 2 ‘ ppFixedFormatTypePDF = 2 End Sub

它将活动的演示文稿保存为PDF格式。每一行代码都会做以下工作。

为PowerPoint名称和PDF名称创建变量将活动的演示文稿名称分配给pptName变量。创建完整的PDF名称将演示文稿保存为PDF格式PowerPoint应用

当VBA代码在PowerPoint演示文稿中运行时，PowerPoint应用程序是默认的应用程序，无需显式引用即可操作。创建一个新的演示文稿

要创建一个演示文稿，请使用PowerPoint应用程序的添加方法。

Application.Presentations.Add’ or without explicit referencePresentations.Add打开一个新的演示文稿

要打开一个新的、空白的演示文稿，请使用Application.Presentations集合的Add方法。

Presentations.Add打开一个现有的演示文稿

要打开您已经创建的演示文稿，请使用Application.Presentations集合的Open方法来打开。

Presentations.Open (“My Presentation.pptx”)

上面的代码假设演示文稿与包含该代码的PowerPoint演示文稿在同一目录下。

打开并分配到一个变量

你应该把你打开的演示文稿分配给一个变量，这样你就可以根据你的要求来操作它。

Dim ppt As PresentationSet ppt = Presentations.Open(“My Presentation.pptx”)引用活动演示文稿

当VBA代码被执行时，使用ActivePrentation来操作GUI中的当前的演示文稿对象。

‘ 将ActivePresentation的名称打印到即时窗口中。Debug.Print ActivePresentation.Name保存当前演示文稿

下面的语句将保存活动演示文稿，如果它之前已经保存了，那么下面的语句将保存活动演示文稿。如果还没有保存过，则会出现 “另存为 “对话框。

ActivePresentation.Save关闭当前演示文稿

以下语句将关闭当前活动的演示文稿，即使在上次编辑后没有保存。

ActivePresentation.Close

有用的参考资料将现有演示文稿（按名称）分配给变量Dim myPresentationByName As PresentationSet myPresentationByName = Application.Presentations(“My Presentation”)将当前活动幻灯片分配给变量Dim currentSlide As SlideSet currentSlide = Application.ActiveWindow.View.Slide将幻灯片按索引分配到变量Dim mySlide As SlideSet mySlide = ActivePresentation.Slides(11)统计幻灯片数量Dim slideCount As LongslideCount = ActivePresentation.Slides.Count获取当前幻灯片的幻灯片序号Dim currentSlideIndex As SlidecurrentSlideIndex = Application.ActiveWindow.View.Slide.SlideIndex在幻灯片末尾添加空白幻灯片Dim slideCount As LongDim newSlide as Slide slideCount = ActivePresentation.Slides.CountSet newSlide = ActivePresentation.Slides.Add(slideCount + 1, 12)’ or as ppLayoutBlank = 12Set newSlide = ActivePresentation.Slides.Add(slideCount + 1, ppLayoutBlank)在当前幻灯片后添加一个幻灯片Dim newSlide As SlideDim currentSlideIndex as Integer currentSlideIndex = Application.ActiveWindow.View.Slide.SlideIndexSet newSlide = ActivePresentation.Slides.Add(currentSlideIndex, ppLayoutBlank)删除一张幻灯片Dim currentSlideIndex as Integer currentSlideIndex = Application.ActiveWindow.View.Slide.SlideIndexActivePresentation.Slides(currentSlideIndex).Delete转到特定的幻灯片’ This will take you to slide number 4Application.ActiveWindow.View.GotoSlide (4)移动幻灯片

您可以将幻灯片从原来的位置移动到新的位置。

‘ Move from slide 3 to first slideDim oldPosition as integer, dim newPosition as integer oldPosition = 3newPosition = 1ActivePresentation.Slides(oldPosition).MoveTo toPos:=newPosition遍历所有幻灯片

你可以在每张幻灯片上做一些事情，也可以翻阅所有的幻灯片，找到几张幻灯片，用代码做一些事情。

Dim mySlide as Slide For Each mySlide In ActivePresentation.Slides ‘ Do something with the current slide referred to in variable ‘mySlide’ ‘ Debug.Print mySlide.NameNext Slide遍历当前幻灯片的所有形状对象

可以通过使用 “形状 “来实现PowerPoint的威力。下面的代码将遍历当前幻灯片上的所有形状，这样你就可以按照你的要求来操作它们。

Dim currentSlide as SlideDim shp as Shape Set currentSlide = Application.ActiveWindow.View.SlideFor Each shp In currentSlide.Shapes ‘ Do something with the current shape referred to in variable ‘shp’ ‘ For example print the name of the shape in the Immediate Window Debug.Print shp.NameNext shp遍历所有幻灯片中的所有形状

你可以通过添加一个循环来遍历所有幻灯片中的所有形状。

Dim currentSlide as SlideDim shp as Shape For Each currentSlide In ActivePresentation.Slides For Each shp In currentSlide.Shapes ‘ Do something with the current shape referred to in variable ‘shp’ Debug.Print shp.Name Next shpNext currentSlide遍历活动幻灯片的所有文本框

文本框是PowerPoint演示文稿中最常用的形状。你可以通过添加一个 “形状类型 “的复选框，在所有的文本框中循环使用。文本框的形状类型定义为VBA常数msoTextBox（常数值为17）。

Dim currentSlide as SlideDim shp as Shape Set currentSlide = Application.ActiveWindow.View.SlideFor Each shp In currentSlide.Shapes ‘ Check if the shape type is msoTextBox If shp.Type = 17 Then ‘ msoTextBox = 17 ‘Print the text in the TextBox Debug.Print shp.TextFrame2.TextRange.Text End IfNext shp遍历所有幻灯片中的所有文本框

同样，你可以通过添加一个循环来遍历所有的幻灯片。

1Dim currentSlide as Slide Dim shp as Shape For Each currentSlide In ActivePresentation.Slides For Each shp In currentSlide.Shapes ‘ Check if the shape type is msoTextBox If shp.Type = 17 Then ‘ msoTextBox = 17 ‘ Do something with the TextBox referred to in variable ‘shp’ Debug.Print shp.TextFrame2.TextRange.Text End If Next shpNext currentSlide将选定的幻灯片复制到新的PPT演示文稿

要将某些幻灯片复制到新的演示文稿中，首先在现有的演示文稿中选择需要的幻灯片，然后运行下面的代码。

Dim currentPresentation as PresentationDim currentSlide as SlideDim newPresentation as Presentation ‘ Save reference to current presentationSet currentPresentation = Application.ActivePresentation ‘ Save reference to current slideSet currentSlide = Application.ActiveWindow.View.Slide ‘ Add new Presentation and save to a referenceSet NewPresentation = Application.Presentations.Add ‘ Copy selected slidesSelection.Copy ‘ Paste it in new PresentationNewPresentation.Slides.Paste将当前幻灯片复制到当前演示文稿的末尾’ Copy current slideApplication.ActiveWindow.View.Slide.Copy ‘ Paste at the endActivePresentation.Slides.Paste

有用的PowerPoint宏示例

这里有一些有用的宏示例，展示如何做任务。这些例子也将展示上述概念。

在幻灯片放映过程中切换当前幻灯片Sub ChangeSlideDuringSlideShow() Dim SlideIndex As Integer Dim SlideIndexPrevious As Integer ‘ Change Current slide to selected slide 4 during slide show SlideIndex = 4 ‘ Index of the current slide show window is 1 in the SlideShowWindows collection SlideIndexPrevious = SlideShowWindows(1).View.CurrentShowPosition SlideShowWindows(1).View.GotoSlide SlideIndex End Sub更改所有文本框中所有幻灯片上的字体Sub ChangeFontOnAllSlides() Dim mySlide As slide Dim shp As Shape ‘ Change Font Size on all Slides For Each mySlide In ActivePresentation.Slides For Each shp In mySlide.Shapes If shp.Type = 17 Then ‘ msoTextBox = 17 ‘ Change Fontsize to 24 shp.TextFrame.TextRange.Font.Size = 24 End If Next shp Next mySlide End Sub将所有文本框中的大小写从大写改为正常值Sub ChangeCaseFromUppertoNormal() Dim mySlide As slide Dim shp As Shape ‘ Change From Upper Case to Normal Case for all slides For Each mySlide In ActivePresentation.Slides For Each shp In mySlide.Shapes If shp.Type = 17 Then ‘ msoTextBox = 17 ‘ Change Upper Case to Normal Case shp.TextFrame2.TextRange.Font.Allcaps = False End If Next shp Next mySlide End Sub在所有文本框的大小写在大写和正常值之间切换Sub ToggleCaseBetweenUpperAndNormal() Dim mySlide As slide Dim shp As Shape ‘ Toggle between Upper Case and Normal Case for all slides For Each mySlide In ActivePresentation.Slides For Each shp In mySlide.Shapes If shp.Type = 17 Then ‘ msoTextBox = 17 ‘ Toggle between Upper Case and Normal Case shp.TextFrame2.TextRange.Font.Allcaps = _ Not shp.TextFrame2.TextRange.Font.Allcaps End If Next shp Next mySlide End Sub移除下划线

在字体设计中，下伸部分是指字母的基线以下的部分。在大多数字体中，下划线是为小写字母保留的，如g、j、q、p、y，有时还有f。

当你在给文字加下划线时，在下伸部分以下的文字看起来并不美观。下面是在整个演示文稿中删除g、j、p、q、y等所有此类字符下划线的代码。

Sub RemoveUnderlineFromDescenders() Dim mySlide As slide Dim shp As Shape Dim descenders_list As String Dim phrase As String Dim x As Long ‘ Remove underlines from Descenders descenders_list = “gjpqy” For Each mySlide In ActivePresentation.Slides For Each shp In mySlide.Shapes If shp.Type = 17 Then ‘ msoTextBox = 17 ‘ Remove underline from letters “gjpqy” With shp.TextFrame.TextRange phrase = .Text For x = 1 To Len(.Text) If InStr(descenders_list, Mid$(phrase, x, 1)) > 0 Then .Characters(x, 1).Font.Underline = False End If Next x End With End If Next shp Next mySlide End Sub从所有幻灯片中删除动画

使用下面的代码来删除演示文稿中设置的所有动画。

Sub RemoveAnimationsFromAllSlides() Dim mySlide As slide Dim i As Long For Each mySlide In ActivePresentation.Slides For i = mySlide.TimeLine.MainSequence.Count To 1 Step -1 ‘Remove Each Animation mySlide.TimeLine.MainSequence.Item(i).Delete Next i Next mySlide End Sub保存演示文稿为PDF

您可以轻松地将Active Presentation保存为PDF格式。

Sub SavePresentationAsPDF() Dim pptName As String Dim PDFName As String ‘ Save PowerPoint as PDF pptName = ActivePresentation.FullName ‘ Replace PowerPoint file extension in the name to PDF PDFName = Left(pptName, InStr(pptName, “.”)) & “pdf” ActivePresentation.ExportAsFixedFormat PDFName, 2 ‘ ppFixedFormatTypePDF = 2 End Sub查找和替换文本

你可以在所有幻灯片的所有文本框中查找和替换文本。在你要查找的文本的第一个实例（由findWhat定义）之后，你需要通过查找命令循环查找其他实例（如果有的话）。

Sub FindAndReplaceText() Dim mySlide As slide Dim shp As Shape Dim findWhat As String Dim replaceWith As String Dim ShpTxt As TextRange Dim TmpTxt As TextRange findWhat = “jackal” replaceWith = “fox” ‘ Find and Find and Replace For Each mySlide In ActivePresentation.Slides For Each shp In mySlide.Shapes If shp.Type = 17 Then ‘ msoTextBox = 17 Set ShpTxt = shp.TextFrame.TextRange ‘Find First Instance of “Find” word (if exists) Set TmpTxt = ShpTxt.Replace(findWhat, _ Replacewhat:=replaceWith, _ WholeWords:=True) ‘Find Any Additional instances of “Find” word (if exists) Do While Not TmpTxt Is Nothing Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length) Set TmpTxt = ShpTxt.Replace(findWhat, _ Replacewhat:=replaceWith, _ WholeWords:=True) Loop End If Next shp Next mySlide End Sub导出幻灯片为图片

您可以将Current SLide（或任何其他幻灯片）导出为PNG或JPG（JPEG）或BMP图像。

Sub ExportSlideAsImage() Dim imageType As String Dim pptName As String Dim imageName As String Dim mySlide As slide ‘ Export current Slide to Image imageType = “png” ‘ or jpg or bmp pptName = ActivePresentation.FullName imageName = Left(pptName, InStr(pptName, “.”)) & imageType Set mySlide = Application.ActiveWindow.View.slide mySlide.Export imageName, imageType End Sub调整图像大小以覆盖整个幻灯片Sub ResizeImageToCoverFullSlide() Dim mySlide As slide Dim shp As Shape ‘ Resize Image to full slide size ‘ Change height and width of the first shape on the current slide ‘ to fit the slide dimensions Set mySlide = Application.ActiveWindow.View.slide Set shp = mySlide.Shapes(1) ” ” Replace two statemetns above with ” the following statement if you want to ” expand the currently selected shape ” will give error if nothing is selected ‘Set shp = ActiveWindow.Selection.ShapeRange(1) With shp .LockAspectRatio = False .Height = ActivePresentation.PageSetup.SlideHeight .Width = ActivePresentation.PageSetup.SlideWidth .Left = 0 .Top = 0 End With End Sub退出所有运行中的幻灯片放映

如果你有多个SlideShow同时打开，那么你可以使用下面的宏关闭所有的SlideShow。

Sub ExitAllRunningSlideShows() Do While SlideShowWindows.Count > 0 SlideShowWindows(1).View.Exit Loop End Sub从Excel自动化操作PowerPoint

您还可以通过其他应用程序（如Excel和Word）连接到PowerPoint。作为第一步，你必须引用一个PowerPoint的实例。

有两种方法可以做到这一点 – 早期绑定和后期绑定。

打开PowerPoint – 早期绑定

在 “早期绑定 “中，您必须在VBE(Visual Basic Editor)中使用 “工具->引用 “选项，显式设置 “Microsoft PowerPoint 16对象库”(适用于MS Office 2019)。

‘ Early BindingDim pptApp As ApplicationSet pptApp = New PowerPoint.Application打开PowerPoint – 后期绑定

在 “后期绑定 “中，应用程序变量被声明为对象，VBA引擎在运行时连接到正确的应用程序。

‘ Late BindingDim pptApp As ObjectSet pptApp = CreateObject(“PowerPoint.Application”)使应用可见

在设置PowperPoint应用程序的引用后，你可能需要使其可见。

pptApp.Visible = True操作PowerPoint

你可以从Excel使用前面描述的所有的从PowerPoint中的方法来操作演示文稿，只需添加对你上面创建的PowerPoint的引用。

举例来说

Presentations.Open (“My Presentation.pptx”)

需要这样使用

pptApp .Presentations.Open (“My Presentation.pptx”)关闭应用程序

一旦你完成了你想做的PowerPoint应用程序，你必须关闭它，并应释放参考。

pptApp.QuitSet pptApp = Nothing从Excel复制到PowerPoint

此代码将从Excel复制一个范围到PowerPoint。

注意：为了展示如何使用VBA将一个范围从Excel复制到PowerPoint中，它尽可能地保持简单。

Sub copyRangeToPresentation() ‘ Open New PowerPoint InstanceSet pptApp = CreateObject(“PowerPoint.Application”) With pptApp ‘ Create A New Presentation Set ppt = .Presentations.Add ‘ Add A Blank Slide Set newSlide = ppt.Slides.Add(1, 12) ‘ ppLayoutBlank = 12 ‘ Copy Range from Active Sheet in Excel ActiveSheet.Range(“A1:E10”).Copy ‘ Paste to Powerpoint as an Image newSlide.Shapes.PasteSpecial DataType:=2 ‘2 = ppPasteEnhancedMetafile ‘ Switch to PowerPoint .ActivateEnd With End Sub