User Rating: 4 / 5

Star ActiveStar ActiveStar ActiveStar ActiveStar Inactive
 

 

Automate Microsoft PowerPoint from Excel, using vba, Run a Slide Show

 

---------------------------------------------------------------------------------------------------------------

Contents:

Automate Microsoft PowerPoint from Excel

Create a new PowerPoint ppt of 3 slides with sound effect, and run a slide show, using Early Binding

Create a new PowerPoint ppt of 4 slides with sound clips and chart, run & view the slide show, automatically close & quit the PowerPoint application, using Early Binding

Create a new PowerPoint ppt of 4 slides with sound effects and chart, run & view the slide show, automatically close & quit the PowerPoint application, using Late Binding

---------------------------------------------------------------------------------------------------------------

 

In this section it is explained how to create, open, insert slide / shape / text and save and close a new PowerPoint ppt, using Automation in vba. Examples have been given to automate using both Early Binding and Late Binding.

 

When you use vba in an Office Application, say PowerPoint, a reference to the PowerPoint Object Library is set by default. When you Automate to work with PowerPoint objects from another application, say Excel, you can add a reference to the PowerPoint object library in Excel (your host application) by clicking Tools-References in VBE, which will enable using PowerPoint's predefined constants. This is a must when you automate using Early Binding (explained earlier). Once this reference is added, a new instance of PowerPoint application can be created by using the New keyword.

 

Automate PowerPoint from Excel, using Late Binding: You need not add a reference to the PowerPoint object library in Excel (your host application), in this case you will not be able to use the PowerPoint's predefined constants and will need to replace them by their numerical values in your code. In Late Binding, the object variable is declared as an Object Type which can be a reference to any object, and this makes an object late bound. In Late Binding, the object library is not exposed during design-time, but the binding happens during run-time using the CreateObject or the GetObject functions. CreateObject creates a new instance of Outlook and GetObject returns an already running instance of the PowerPoint object.

 

Click here for a detailed explanation of Automation using Early Binding and Late Binding.

 

Scroll down to Example 3 to download an Excel file, for live code of a 4-slide PowerPoint Presentation which Runs an automated Slide Show.

 

 

 

Example 1: Create a new PowerPoint ppt of 3 slides with sound effect, and run a slide show, using Early Binding.

 

Sub Automating_PowerPoint_from_Excel_1()
'Automate using Early Binding: Add a reference to the PowerPoint Object Library in Excel (your host application) by clicking Tools-References in VBE, which will enable using PowerPoint's predefined constants. Once this reference is added, a new instance of PowerPoint application can be created by using the New keyword.


'Create a new PowerPoint ppt of 3 slides with sound effect, and run a slide show.

 

'variables declared as a specific object type ie. specific to the application which is being automated:
Dim applPP As PowerPoint.Application
Dim prsntPP As PowerPoint.Presentation
Dim slidePP As PowerPoint.Slide
Dim shapePP As PowerPoint.Shape
Dim lSlideCount As Long
Dim strPpPath As String, strPpName As String

'Create a new instance of the PowerPoint application. Set the Application object as follows:
Set applPP = New PowerPoint.Application

'make the PowerPoint window visible:
applPP.Visible = True
'maximize PowerPoint window:
applPP.WindowState = ppWindowMaximized

'create a new presentation in PowerPoint:
Set prsntPP = applPP.Presentations.Add

 

'set path where to save the new presentation, to the same location as the host workbook:
strPpPath = ThisWorkbook.Path
'set name for the new presentation with the defined path as determined above:
strPpName = strPpPath & "\" & "newPresentation1.pptx"

'saves the new presentation, with the specified name and path:
prsntPP.SaveAs Filename:=strPpName

'use the SlideMaster Property to set the background for all slides:
prsntPP.SlideMaster.Background.Fill.PresetTextured msoTextureStationery

'-------------------------
'ADD FIRST SLIDE:
'The title slide (ppLayoutTitleOnly) has 1 shape, Shape(1) is the title, you can add your own shapes to the slide:
'add a title slide to the new presentation:
Set slidePP = prsntPP.Slides.Add(Index:=1, Layout:=ppLayoutTitleOnly)


'use the SlideShowTransition Property to determine how the slide advances in a slide show:

With slidePP.SlideShowTransition

.Speed = ppTransitionSpeedFast
.EntryEffect = ppEffectWedge
'set AdvanceOnTime property to true for the slide to advance automatically after the specified time gap:
.AdvanceOnTime = msoTrue
'AdvanceTime Property sets the time gap in seconds for the specified slide transition.
'set the slide advance time of 20 seconds before it advances to the next slide:

.AdvanceTime = 17

End With


'REFER FIRST SHAPE IN FIRST SLIDE:
'Text Frame refers to the area within a shape that holds text and it has properties and methods to control its alignment and anchoring.
'TextRange refers to text in a shape and it has properties and methods to add and manipulate text.
'set the title text on the slide:
slidePP.Shapes.Title.TextFrame.TextRange.Text = "Sales Performance - 2012"

'ADD SECOND SHAPE IN FIRST SLIDE:
'create a new shape in the slide:
Set shapePP = slidePP.Shapes.AddShape(Type:=msoShapeOval, Left:=50, Top:=150, Width:=120, Height:=90)

 

With shapePP

.Fill.ForeColor.RGB = RGB(255, 0, 0)
.TextFrame.TextRange.Text = "Presented by Scott Kelly"
.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = 12
.TextEffect.FontBold = msoTrue

'use the Shape.AnimationSettings Property to apply special effects for animation of a shape during a slide show:

With .AnimationSettings

.SoundEffect.Name = "Camera"
.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 2
.EntryEffect = ppEffectFlyFromLeft
'use TextUnitEffect Property to determine how the text is animated - by paragraph, by word, or by letter:

.TextUnitEffect = ppAnimateByParagraph

End With

End With


'ADD THIRD SHAPE IN FIRST SLIDE:
'create a new shape in the slide:
Set shapePP = slidePP.Shapes.AddShape(Type:=msoShape8pointStar, Left:=220, Top:=200, Width:=250, Height:=270)
 

'set the shape properties:

With shapePP

.Name = "Company"
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.2
.Line.Style = msoLineSingle

'note that vbCrLf or Chr(13) have the effect of creating a new paragraph:
.TextFrame.TextRange.Text = "Company Name: CarSalesCo Inc, USA" & vbCrLf & vbCrLf & "Includes" & vbCrLf & "all Branches Worldwide"

.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = 18

.TextEffect.FontBold = msoTrue

With .AnimationSettings

'Set the AnimationSettings.AdvanceMode Property to ppAdvanceOnTime, for the animation to start automatically after the specified time gap.
.AdvanceMode = ppAdvanceOnTime
'animate specified shape automatically after 2 seconds:
.AdvanceTime = 2
.SoundEffect.Name = "Camera"
.EntryEffect = ppEffectFlyFromLeft
'The AnimationSettings.TextLevelEffect Property determines the paragraph level by which the text in a shape gets animated:
.TextLevelEffect = ppAnimateBySecondLevel

.TextUnitEffect = ppAnimateByCharacter

End With

End With


'-------------------------
'ADD SECOND SLIDE:
lSlideCount = prsntPP.Slides.Count

'The text slide (ppLayoutText)has 2 shapes wherein text can be inserted, Shape(1) is the title, and Shape(2) is the bulleted text area:
Set slidePP = prsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=ppLayoutText)

 

With slidePP.SlideShowTransition

.Speed = ppTransitionSpeedSlow
.EntryEffect = ppEffectFadeSmoothly
.AdvanceOnTime = msoTrue

.AdvanceTime = 12

End With

 

'REFER THE FIRST SHAPE IN SECOND SLIDE :

With slidePP.Shapes(1)

.TextFrame.TextRange.Text = "Your Company has returned a Bumper Sales Performance during the Financial Year 2012. Highlights:"

 

.TextFrame.TextRange.Font.Name = "Verdana"
.TextFrame.TextRange.Font.Color = RGB(255, 0, 0)
.TextFrame.TextRange.Font.Size = 20

.TextEffect.FontBold = msoTrue

With .AnimationSettings

.SoundEffect.Name = "Camera"
.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 2
.TextUnitEffect = ppAnimateByParagraph

.EntryEffect = ppEffectFlyFromRight

End With

End With


'REFER THE SECOND SHAPE IN SECOND SLIDE:

With slidePP.Shapes(2)

'use the TextRange.ParagraphFormat Property to do paragraph formatting for the specified text.

With .TextFrame.TextRange.ParagraphFormat

'set paragraph alignment:
.Alignment = ppAlignJustify
'msoTrue indicates that line spacing is set to a specific number of lines between base lines whereas msoFalse indicates that line spacing is set to a specific number of points:
.LineRuleWithin = msoTrue
'set space between base lines:
.SpaceWithin = 1.2
'msoTrue indicates that line spacing is set to a specific number of lines before each paragraph's first line whereas msoFalse indicates that line spacing is set to a specific number of points.
.LineRuleBefore = msoTrue
'set the space after before each paragraph's first line:
.SpaceBefore = 0.5
'msoTrue indicates that line spacing is set to a specific number of lines after each paragraph's last line whereas msoFalse indicates that line spacing is set to a specific number of points.
.LineRuleAfter = msoTrue
'set the space after after each paragraph's last line:

.SpaceAfter = 0.75

End With

'this shape is the bulleted text area, here we are changing the bullet type:
.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletNumbered

.TextFrame.TextRange.Text = "All Sales Targets have been Exceeded and this is due to the tremendous efforts of the staff and management led by the Managing Director, Mr. Kurt Murray" & Chr(13) & "200% Sales Growth over the Previous Year" & Chr(13) & "250% Increase in Net Profit" & Chr(13) & "Best Sales Performance Region - North America" & Chr(13) & "Record Sales in the Month of June" & Chr(13) & "Best Individual Target Achievment - Mr. Jim Holland"

.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 18
.TextEffect.FontBold = msoTrue

With .AnimationSettings

.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 2
.SoundEffect.Name = "Camera"
.TextUnitEffect = ppAnimateByParagraph

.EntryEffect = ppEffectFlyFromRight

End With

End With


'-------------------------
'ADD THIRD SLIDE:
lSlideCount = prsntPP.Slides.Count

'Being a blank slide (ppLayoutBlank), it has no shapes, you can add your shapes to the slide:
Set slidePP = prsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=ppLayoutBlank)

'You use the SlideMaster Property to set the background gradient for all slides, as shown in the beginning. If you want to set the background for an individual slide without affecting other slides, you need to set the FollowMasterBackground property of a slide to False, as shown below.
slidePP.FollowMasterBackground = False
slidePP.Background.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, PresetGradientType:=msoGradientDesert

 

With slidePP.SlideShowTransition

.Speed = ppTransitionSpeedSlow
.EntryEffect = ppEffectBoxOut
.AdvanceOnTime = msoTrue

.AdvanceTime = 10

End With


'create a new shape in the slide:
Set shapePP = slidePP.Shapes.AddShape(Type:=msoShapeRectangle, Left:=10, Top:=10, Width:=470, Height:=250)

'activate the new slide:
applPP.ActiveWindow.View.GotoSlide prsntPP.Slides.Count
'select shape to align:
shapePP.Select
'aligning a shape(s):
'ShapeRange object represents all slide objects selected in the slide. Align (ie. ShapeRange.Align Method) works with ShapeRange, and not with a Shape, hence selection of a shape is required to use the Selection.ShapeRange Property as below.
applPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
applPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue

'Aligns all shapes in the slide:
'slidePP.Shapes.Range.Align msoAlignCenters, msoTrue

'vertical alignment of textframe in the selected shape:
applPP.ActiveWindow.Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorTop

 

'REFER THE FIRST SHAPE IN THIRD SLIDE:

With shapePP

.Fill.ForeColor.RGB = RGB(255, 100, 100)

'Chr(32) adds a space; Chr(13) is carriage return and has the effect of creating a new paragraph:
.TextFrame.TextRange.Text = Chr(32) & "We hope to Continue this Strong Performance" & Chr(13) & Chr(13) & Chr(32) & "Thank You Ladies & Gentlemen" & Chr(13) & Chr(13) & Chr(32) & "End of Presentation"

.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignJustify
'add bullets to all text in the range:
.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered
'to add bullets to the first paragraph:
'.TextFrame.TextRange.Paragraphs(1).ParagraphFormat.Bullet.Type = ppBulletUnnumbered
'to add bullets to the last paragraph:
'.TextFrame.TextRange.Paragraphs(.TextFrame.TextRange.Paragraphs.Count).ParagraphFormat.Bullet.Character = 8226
'indent last para:
.TextFrame.TextRange.Paragraphs(3).IndentLevel = 2
.TextFrame.TextRange.Paragraphs(.TextFrame.TextRange.Paragraphs.Count).IndentLevel = 3
.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 20

.TextEffect.FontBold = msoTrue

With .AnimationSettings

.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 2
'You can assign different sound effects for each shape viz. Chime, Applause, etc. Play the powerpoint sound named Applause:
.SoundEffect.Name = "Chime"
.TextUnitEffect = ppAnimateByParagraph

.EntryEffect = ppEffectCheckerboardAcross

End With

End With


'-------------------------
'FONT SETTINGS IN FIRST SLIDE:

'refer shape by its name:
prsntPP.Slides(1).Shapes("Company").TextFrame.TextRange.Paragraphs(1).Lines(1).Font.Italic = True
'format as italic the second and third lines of the first paragraph in shape three on slide one in the current powerpoint presentation:
prsntPP.Slides(1).Shapes(3).TextFrame.TextRange.Paragraphs(1).Lines(2, 3).Font.Color = vbBlue
prsntPP.Slides(1).Shapes(3).TextFrame.TextRange.Paragraphs(3).Lines(1).Font.Underline = True

'-------------------------
'SAVE PRESENTATION, AND RUN THE SLIDE SHOW:

'save the presentation:
prsntPP.Save

'minimize Excel window:
Application.WindowState = xlMinimized

lSlideCount = prsntPP.Slides.Count
'run the slide show:
applPP.ActiveWindow.View.GotoSlide 1

'use the SlideShowSettings Property to set the slide show settings of the presentation:

With prsntPP.SlideShowSettings

.StartingSlide = 1
.EndingSlide = lSlideCount
'slides will advance per the timings (ie. SlideShowTransition.AdvanceTime) set therein:
.AdvanceMode = ppSlideShowUseSlideTimings

.run

End With

 

End Sub

 

 

 

Example 2: Create a new PowerPoint ppt of 4 slides with sound clips and chart, run & view the slide show, automatically close & quit the PowerPoint application, using Early Binding.

 

Sub Automating_PowerPoint_from_Excel_2()
'Automate using Early Binding: Add a reference to the PowerPoint Object Library in Excel (your host application) by clicking Tools-References in VBE, which will enable using PowerPoint's predefined constants. Once this reference is added, a new instance of PowerPoint application can be created by using the New keyword.


'Create a new PowerPoint ppt of 4 slides with sound clips and chart, run & view the slide show, automatically close & quit the PowerPoint application.

 

'variables declared as a specific object type ie. specific to the application which is being automated:
Dim applPP As PowerPoint.Application
Dim prsntPP As PowerPoint.Presentation
Dim slidePP As PowerPoint.Slide
Dim shapePP As PowerPoint.Shape
Dim shapeSoundPP As PowerPoint.Shape
Dim lSlideCount As Long
Dim oSlideShowPP As Object
Dim strPpPath As String, strPpName As String

'Create a new instance of the PowerPoint application. Set the Application object as follows:
Set applPP = New PowerPoint.Application

'make the PowerPoint window visible:
applPP.Visible = True
'maximize PowerPoint window:
applPP.WindowState = ppWindowMaximized

'create a new presentation in PowerPoint:
Set prsntPP = applPP.Presentations.Add
'set path where to save the new presentation, to the same location as the host workbook:
strPpPath = ThisWorkbook.Path
'set name for the new presentation with the defined path as determined above:
strPpName = strPpPath & "\" & "newPresentation1.pptx"

'saves the new presentation, with the specified name and path:
prsntPP.SaveAs Filename:=strPpName

'use the SlideMaster Property to set the background gradient for all slides:
prsntPP.SlideMaster.Background.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, PresetGradientType:=msoGradientDaybreak

'-------------------------
'ADD FIRST SLIDE:
'The title slide (ppLayoutTitleOnly) has 1 shape, Shape(1) is the title, you can add your own shapes to the slide:
'add a title slide to the new presentation:
Set slidePP = prsntPP.Slides.Add(Index:=1, Layout:=ppLayoutTitleOnly)

'ADD SECOND SHAPE IN FIRST SLIDE (MEDIA OBJECT):
'Add sound in your slide - use the Shapes.AddMediaObject Method to create a media object:
Set shapeSoundPP = slidePP.Shapes.AddMediaObject("C:\Users\Amit Tandon\Documents\Sound\10 S.O.S..m4a", Left:=5, Top:=5, Width:=10, Height:=10)

 

'use AnimationSettings.PlaySettings Property to set how the sound clip plays during the slide show:

With shapeSoundPP.AnimationSettings.PlaySettings

'play sound automatically after the slide transition:
.PlayOnEntry = True
'Determine whether to pause the slide show till the finish of the sound clip:
.PauseAnimation = False
'two slides will be displayed before the sound clip stops playing:

.StopAfterSlides = 2

End With

 

'use the SlideShowTransition Property to determine how the slide advances in a slide show:

With slidePP.SlideShowTransition

.Speed = ppTransitionSpeedFast
.EntryEffect = ppEffectWedge
'set AdvanceOnTime property to true for the slide to advance automatically after the specified time gap:
.AdvanceOnTime = msoTrue
'AdvanceTime Property sets the time gap in seconds for the specified slide transition.
'set the slide advance time of 20 seconds before it advances to the next slide:

.AdvanceTime = 20

End With


'REFER FIRST SHAPE IN FIRST SLIDE:
'Text Frame refers to the area within a shape that holds text and it has properties and methods to control its alignment and anchoring.
'TextRange refers to text in a shape and it has properties and methods to add and manipulate text.
'set the title text on the slide:
slidePP.Shapes.Title.TextFrame.TextRange.Text = "Sales Performance - 2012"

'ADD THIRD SHAPE IN FIRST SLIDE:
'create a new shape in the slide:
Set shapePP = slidePP.Shapes.AddShape(Type:=msoShapeOval, Left:=50, Top:=150, Width:=120, Height:=90)

 

With shapePP

.Fill.ForeColor.RGB = RGB(255, 0, 0)
.TextFrame.TextRange.Text = "Presented by Scott Kelly"
.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = 12

.TextEffect.FontBold = msoTrue

'use the Shape.AnimationSettings Property to apply special effects for animation of a shape during a slide show:

With .AnimationSettings

.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 2
.EntryEffect = ppEffectFlyFromLeft
'use TextUnitEffect Property to determine how the text is animated - by paragraph, by word, or by letter:

.TextUnitEffect = ppAnimateByWord

End With

End With


'ADD FOURTH SHAPE IN FIRST SLIDE:
'create a new shape in the slide:
Set shapePP = slidePP.Shapes.AddShape(Type:=msoShape8pointStar, Left:=220, Top:=200, Width:=250, Height:=270)
 

'set the shape properties:

With shapePP

.Name = "Company"
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.Style = msoLineThickThin

'note that vbCrLf or Chr(13) have the effect of creating a new paragraph:
.TextFrame.TextRange.Text = "Company Name: CarSalesCo Inc, USA" & vbCrLf & vbCrLf & "Includes" & vbCrLf & "all Branches Worldwide"

.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = 18

.TextEffect.FontBold = msoTrue

With .AnimationSettings

'Set the AnimationSettings.AdvanceMode Property to ppAdvanceOnTime, for the animation to start automatically after the specified time gap.
.AdvanceMode = ppAdvanceOnTime
'animate specified shape automatically after 2 seconds:
.AdvanceTime = 2
.EntryEffect = ppEffectFlyFromLeft
'The AnimationSettings.TextLevelEffect Property determines the paragraph level by which the text in a shape gets animated:
.TextLevelEffect = ppAnimateBySecondLevel

.TextUnitEffect = ppAnimateByCharacter

End With

End With


'-------------------------
'ADD SECOND SLIDE:
lSlideCount = prsntPP.Slides.Count

'The text slide (ppLayoutText)has 2 shapes wherein text can be inserted, Shape(1) is the title, and Shape(2) is the bulleted text area:
Set slidePP = prsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=ppLayoutText)

 

With slidePP.SlideShowTransition

.Speed = ppTransitionSpeedSlow
.EntryEffect = ppEffectUncoverDown
.AdvanceOnTime = msoTrue

.AdvanceTime = 12

End With

 

'REFER THE FIRST SHAPE IN SECOND SLIDE:

With slidePP.Shapes(1)

.TextFrame.TextRange.Text = "Your Company has returned a Bumper Sales Performance during the Financial Year 2012. Highlights:"

.TextFrame.TextRange.Font.Name = "Verdana"
.TextFrame.TextRange.Font.Color = RGB(0, 255, 0)
.TextFrame.TextRange.Font.Size = 20

.TextEffect.FontBold = msoTrue

With .AnimationSettings

.AdvanceMode = ppAdvanceOnTime
.TextUnitEffect = ppAnimateByParagraph

.EntryEffect = ppEffectFlyFromRight

End With

End With


'REFER THE SECOND SHAPE IN SECOND SLIDE:

With slidePP.Shapes(2)

'use the TextRange.ParagraphFormat Property to do paragraph formatting for the specified text.
'this shape is the bulleted text area, here we are changing the bullet type:
.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletNumbered
.TextFrame.TextRange.Text = "All Sales Targets have been Exceeded" & Chr(13) & Chr(13) & "200% Sales Growth over the Previous Year" & Chr(13) & Chr(13) & "250% Increase in Net Profit" & Chr(13) & Chr(13) & "Best Sales Performance Region - North America" & Chr(13) & Chr(13) & "Record Sales in the Month of June" & Chr(13) & Chr(13) & "Best Individual Target Achievment - Mr. Jim Holland"
.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 18
.TextEffect.FontBold = msoTrue

With .AnimationSettings

.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 1
.TextUnitEffect = ppAnimateByParagraph
.TextLevelEffect = ppAnimateBySecondLevel

.EntryEffect = ppEffectFlyFromRight

End With

End With


'-------------------------
'ADD THIRD SLIDE:
lSlideCount = prsntPP.Slides.Count
Set slidePP = prsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=ppLayoutTitleOnly)

 

With slidePP.SlideShowTransition

.Speed = ppTransitionSpeedFast
'use the SoundEffect.ImportFromFile Method to specify the sound to play when the slide transition happens - add a .wav format file. Specify the full name and path of the sound file. WAV is a supported audio file format in powerpoint. Note that a supported audio file extension may also not play correctly if the correct codec version is not installed, or if the file is not programmed in a format recognized by your version of Microsoft Windows.
.SoundEffect.ImportFromFile "C:\Users\Amit Tandon\Documents\Sound\Audio_2.wav"
'audio will play till the start of the next sound:
.LoopSoundUntilNext = msoTrue
.EntryEffect = ppEffectWheel1Spoke
.AdvanceOnTime = msoTrue

.AdvanceTime = 10

End With


slidePP.Shapes.Title.TextFrame.TextRange.Text = "Sales Performance - 2012"

 

'REFER THE FIRST SHAPE IN THIRD SLIDE - SET TITLE:

With slidePP.Shapes(1)

.TextFrame.TextRange.Text = "Sales and Profitability Chart"
.TextFrame.TextRange.Font.Name = "Verdana"
.TextFrame.TextRange.Font.Color = vbYellow
.TextFrame.TextRange.Font.Size = 20

.TextEffect.FontBold = msoTrue

With .AnimationSettings

.AdvanceMode = ppAdvanceOnTime
.TextUnitEffect = ppAnimateByParagraph

.EntryEffect = ppEffectFlyFromTop

End With

End With


'ADD SECOND SHAPE, AS CHART, IN THIRD SLIDE:

ThisWorkbook.Worksheets("Sheet3").ChartObjects("SalesPerfChart").Copy
slidePP.Shapes.Paste

Set shapePP = slidePP.Shapes(slidePP.Shapes.Count)

 

With shapePP

.Top = slidePP.Shapes(slidePP.Shapes.Count - 1).Top + slidePP.Shapes(slidePP.Shapes.Count - 1).Height + 25
.Left = slidePP.Shapes(slidePP.Shapes.Count - 1).Left
.Width = slidePP.Shapes(slidePP.Shapes.Count - 1).Width

.Height = 300

With .AnimationSettings

.EntryEffect = ppEffectZoomIn
.AdvanceMode = ppAdvanceOnTime

.AdvanceTime = 2

End With

End With


'-------------------------

'ADD FOURTH SLIDE:
lSlideCount = prsntPP.Slides.Count

'Being a blank slide (ppLayoutBlank), it has no shapes, you can add your shapes to the slide:
Set slidePP = prsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=ppLayoutBlank)

'You use the SlideMaster Property to set the background gradient for all slides, as shown in the beginning. If you want to set the background for an individual slide without affecting other slides, you need to set the FollowMasterBackground property of a slide to False, as shown below.
slidePP.FollowMasterBackground = False
slidePP.Background.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, PresetGradientType:=msoGradientCalmWater
 

With slidePP.SlideShowTransition

.Speed = ppTransitionSpeedSlow
.EntryEffect = ppEffectBoxOut
.AdvanceOnTime = msoTrue

.AdvanceTime = 10

End With


'create a new shape in the slide:
Set shapePP = slidePP.Shapes.AddShape(Type:=msoShapeRectangle, Left:=10, Top:=10, Width:=470, Height:=250)
'activate the new slide:
applPP.ActiveWindow.View.GotoSlide prsntPP.Slides.Count
'select shape to align:
shapePP.Select
'aligning a shape(s):
'ShapeRange object represents all slide objects selected in the slide. Align (ie. ShapeRange.Align Method) works with ShapeRange, and not with a Shape, hence selection of a shape is required to use the Selection.ShapeRange Property as below.
applPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
applPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
'Aligns all shapes in the slide:
'slidePP.Shapes.Range.Align msoAlignCenters, msoTrue
'vertical alignment of textframe in the selected shape:
applPP.ActiveWindow.Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorTop


'REFER THE FIRST SHAPE IN FOURTH SLIDE:

With shapePP

'Chr(32) adds a space; Chr(13) is carriage return and has the effect of creating a new paragraph:
.TextFrame.TextRange.Text = Chr(32) & "We hope to Continue this Strong Performance" & Chr(13) & Chr(13) & Chr(32) & "Thank You Ladies & Gentlemen" & Chr(13) & Chr(13) & Chr(32) & "End of Presentation"
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignJustify
'add bullets to all text in the range:
.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered
'to add bullets to the first paragraph:
'.TextFrame.TextRange.Paragraphs(1).ParagraphFormat.Bullet.Type = ppBulletUnnumbered
'to add bullets to the last paragraph:
'.TextFrame.TextRange.Paragraphs(.TextFrame.TextRange.Paragraphs.Count).ParagraphFormat.Bullet.Character = 8226
'indent last para:
.TextFrame.TextRange.Paragraphs(3).IndentLevel = 2
.TextFrame.TextRange.Paragraphs(.TextFrame.TextRange.Paragraphs.Count).IndentLevel = 3
.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 20

.TextEffect.FontBold = msoTrue

With .AnimationSettings

.AdvanceMode = ppAdvanceOnTime
'You can assign different sound effects for each shape viz. Chime, Appluase, etc. Play the powerpoint sound named Applause:
.SoundEffect.Name = "Applause"
.TextUnitEffect = ppAnimateByParagraph

.EntryEffect = ppEffectCheckerboardAcross

End With

End With


'-------------------------
'FONT SETTINGS IN FIRST SLIDE:

'refer shape by its name:
prsntPP.Slides(1).Shapes("Company").TextFrame.TextRange.Paragraphs(1).Lines(1).Font.Italic = True
'format as italic the second and third lines of the first paragraph in shape four on slide one in the current powerpoint presentation:
prsntPP.Slides(1).Shapes(4).TextFrame.TextRange.Paragraphs(1).Lines(2, 3).Font.Color = vbBlue
prsntPP.Slides(1).Shapes(4).TextFrame.TextRange.Paragraphs(3).Lines(1).Font.Underline = True

'-------------------------
'SAVE PRESENTATION, AND RUN THE SLIDE SHOW:

'save the presentation:
prsntPP.Save

'minimize Excel window:
Application.WindowState = xlMinimized

lSlideCount = prsntPP.Slides.Count

'run the slide show:
applPP.ActiveWindow.View.GotoSlide 1

'use the SlideShowSettings Property to set the slide show settings of the presentation:
With prsntPP.SlideShowSettings

.StartingSlide = 1
.EndingSlide = lSlideCount
'slides will advance per the timings (ie. SlideShowTransition.AdvanceTime) set therein:
.AdvanceMode = ppSlideShowUseSlideTimings

.run

End With


'The SlideShowSettings.Run Method runs a slide show. Use the Run method of the SlideShowSettings to create a new Slide Show Window, and then use the View property to return the Slide Show View (ie. the view in a slide show window).
'set variable of the SlideShowSettings.Run.View object:
Set oSlideShowPP = prsntPP.SlideShowSettings.run.View

'use the SlideShowView.State Property to return the state of the slide show.
'the slide show will run till the end of all slides and exit the loop in case of error:

Do Until oSlideShowPP.State = ppSlideShowDone

'Err.Number = 0 means no error:

If Err.Number <> 0 Then

Exit Do

End If

Loop


'Note that the slide show is being run using the SlideShowSettings.Run method and the SlideShowView.State Property in this example, but the code will not work in PowerPoint 2007 with Late Binding. In the code line -- Do Until oSlideShowPP.State = ppSlideShowDone -- the built-in constant ppSlideShowDone will need to be replaced by its value of 5 while using Late Binding, which fails while running the code. To automatically run the slide show using late Binding in PowerPoint 2007, see next example.

'-------------------------
'CLOSE PRESENTATION, CLEAR VARIABLES AND QUIT APPLICATION:

'though this does not actually save the presentation, it avoids a dialog box asking to save changes:
prsntPP.Saved = True

'close presentation
prsntPP.Close

'clear the variables:
Set shapePP = Nothing
Set slidePP = Nothing
Set prsntPP = Nothing
Set shapeSoundPP = Nothing
Set oSlideShowPP = Nothing
    
'quit PowerPoint application:
applPP.Quit

'clear the variable:
Set applPP = Nothing


End Sub

 

 

 

Example 3: Create a new PowerPoint ppt of 4 slides with sound effects and chart, run & view the slide show, automatically close & quit the PowerPoint application, using Late Binding.

For live code of this example, click to download excel file.

 

Sub Automating_PowerPoint_from_Excel_3()
'Automate PowerPoint from Excel, using Late Binding. You need not add a reference to the PowerPoint object library in Excel (your host application), in this case you will not be able to use the PowerPoint's predefined constants and will need to replace them by their numerical values in your code.

'Create a new PowerPoint ppt of 4 slides with sound effects and chart, run & view the slide show, automatically close & quit the PowerPoint application.


'variables declared as Object Type, which can be a reference to any object:
Dim oApplPP As Object
Dim oPrsntPP As Object
Dim oSlidePP As Object
Dim oShapePP As Object
Dim oSlideShowPP As Object
Dim lSlideCount As Long
Dim dtSlideAdvanceTime As Date
Dim ws As Worksheet
Dim strPpPath As String, strPpName As String

'Set a SlideShowTransition.AdvanceTime of 20 seconds for all slides. This should synchronize with the delay time inserted (at the end) for running the slide show.
dtSlideAdvanceTime = 20

'Create a new instance of the PowerPoint application, if an existing PowerPoint object is not available.
'Set the Application object as follows:
On Error Resume Next
Set oApplPP = GetObject(, "PowerPoint.Application")
'if an instance of an existing PowerPoint object is not available, an error will occur (Err.Number = 0 means no error):

If Err.Number <> 0 Then

Set oApplPP = CreateObject("PowerPoint.Application")

End If
'disable error handling:
On Error GoTo 0

'make the PowerPoint window visible:
oApplPP.Visible = True
'maximize PowerPoint window. Built-in constant ppWindowMaximized has been replaced by its numerical value 3:
oApplPP.WindowState = 3

'create a new presentation in PowerPoint:
Set oPrsntPP = oApplPP.Presentations.Add
'set path where to save the new presentation, to the same location as the host workbook:
strPpPath = ThisWorkbook.Path
'set name for the new presentation with the defined path as determined above:
strPpName = strPpPath & "\" & "newPresentation1.pptx"

'saves the new presentation, with the specified name and path:
oPrsntPP.SaveAs Filename:=strPpName

'use the SlideMaster Property to set the background gradient for all slides:
'Built-in constants msoGradientHorizontal and msoGradientDaybreak have been replaced by their numerical values of 1 and 4:
oPrsntPP.SlideMaster.Background.Fill.PresetGradient Style:=1, Variant:=1, PresetGradientType:=4

'-------------------------
'ADD FIRST SLIDE:
'The title slide (ppLayoutTitleOnly) has 1 shape, Shape(1) is the title, you can add your own shapes to the slide:
'Add a title slide to the new presentation. Built-in constant ppLayoutTitleOnly has been replaced by its value 11.
Set oSlidePP = oPrsntPP.Slides.Add(Index:=1, Layout:=11)


'use the SlideShowTransition Property to determine how the slide advances in a slide show:
With oSlidePP.SlideShowTransition

'Built-in constant ppTransitionSpeedFast has been replaced by its value 3.
.Speed = 3
'Built-in constant ppEffectWedge has been replaced by its value 3856.
.EntryEffect = 3856
'set AdvanceOnTime property to true for the slide to advance automatically after the specified time gap:
'Built-in constant msoTrue has been replaced by its value -1.
.AdvanceOnTime = -1
'AdvanceTime Property sets the time gap in seconds for the specified slide transition.
'set the slide advance time of 20 seconds before it advances to the next slide:

.AdvanceTime = dtSlideAdvanceTime

End With


'REFER FIRST SHAPE IN FIRST SLIDE:
'Text Frame refers to the area within a shape that holds text and it has properties and methods to control its alignment and anchoring.
'TextRange refers to text in a shape and it has properties and methods to add and manipulate text.
'set the title text on the slide:
oSlidePP.Shapes.Title.TextFrame.TextRange.Text = "Sales Performance - 2012"

'ADD SECOND SHAPE IN FIRST SLIDE:
'Create a new shape in the slide. Built-in constant msoShapeOval has been replaced by its value 9.
Set oShapePP = oSlidePP.Shapes.AddShape(Type:=9, Left:=50, Top:=150, Width:=120, Height:=90)

 

With oShapePP

.Fill.ForeColor.RGB = RGB(255, 0, 0)
.TextFrame.TextRange.Text = "Presented by Scott Kelly"
.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = 12
'Built-in constant msoTrue has been replaced by its value -1.
.TextEffect.FontBold = -1

'use the Shape.AnimationSettings Property to apply special effects for animation of a shape during a slide show:

With .AnimationSettings

'Built-in constant ppAdvanceOnTime has been replaced by its value 2.
.AdvanceMode = 2
.AdvanceTime = 2
.SoundEffect.Name = "Wind"
'Built-in constant ppEffectFlyFromLeft has been replaced by its value 3329.
.EntryEffect = 3329
'use TextUnitEffect Property to determine how the text is animated - by paragraph, by word, or by letter:
'Built-in constant ppAnimateByParagraph has been replaced by its value 0.

.TextUnitEffect = 0

End With

End With

 

'ADD THIRD SHAPE IN FIRST SLIDE:
'create a new shape in the slide:
'Built-in constant msoShape8pointStar has been replaced by its value 93.
Set oShapePP = oSlidePP.Shapes.AddShape(Type:=93, Left:=220, Top:=200, Width:=250, Height:=270)

 

'set the shape properties:

With oShapePP

.Name = "Company"
.Fill.ForeColor.RGB = RGB(0, 255, 0)
'Built-in constant msoLineThickThin has been replaced by its value 4.
.Line.Style = 4

'note that vbCrLf or Chr(13) have the effect of creating a new paragraph:
.TextFrame.TextRange.Text = "Company Name: CarSalesCo Inc, USA" & vbCrLf & vbCrLf & "Includes" & vbCrLf & "all Branches Worldwide"

.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = 18
'Built-in constant msoTrue has been replaced by its value -1.

.TextEffect.FontBold = -1

With .AnimationSettings

'Set the AnimationSettings.AdvanceMode Property to ppAdvanceOnTime, for the animation to start automatically after the specified time gap.
'Built-in constant ppAdvanceOnTime has been replaced by its value 2.
.AdvanceMode = 2
'animate specified shape automatically after 2 seconds:
.AdvanceTime = 2
.SoundEffect.Name = "Wind"
'Built-in constant ppEffectFlyFromLeft has been replaced by its value 3329.
.EntryEffect = 3329
'The AnimationSettings.TextLevelEffect Property determines the paragraph level by which the text in a shape gets animated:
'Built-in constant ppAnimateBySecondLevel has been replaced by its value 2.
.TextLevelEffect = 2
'Built-in constant ppAnimateByCharacter has been replaced by its value 2.

.TextUnitEffect = 2

End With

End With


'-------------------------
'ADD SECOND SLIDE:
lSlideCount = oPrsntPP.Slides.Count

'The text slide (ppLayoutText)has 2 shapes wherein text can be inserted, Shape(1) is the title, and Shape(2) is the bulleted text area:
'Built-in constant ppLayoutText has been replaced by its value 2.
Set oSlidePP = oPrsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=2)

 

With oSlidePP.SlideShowTransition

'Built-in constant ppTransitionSpeedFast has been replaced by its value 3.
.Speed = 3
'Built-in constant ppEffectUncoverDown has been replaced by its value 2052.
.EntryEffect = 2052
'Built-in constant msoTrue has been replaced by its value -1.
.AdvanceOnTime = -1

.AdvanceTime = dtSlideAdvanceTime

End With

 

'REFER THE FIRST SHAPE IN SECOND SLIDE:

With oSlidePP.Shapes(1)

.TextFrame.TextRange.Text = "Your Company has returned a Bumper Sales Performance during the Financial Year 2012. Highlights:"

.TextFrame.TextRange.Font.Name = "Verdana"
.TextFrame.TextRange.Font.Color = vbYellow
.TextFrame.TextRange.Font.Size = 20
'Built-in constant msoTrue has been replaced by its value -1.

.TextEffect.FontBold = -1

With .AnimationSettings

'Built-in constant ppAdvanceOnTime has been replaced by its value 2.
.AdvanceMode = 2
.AdvanceTime = 1
.SoundEffect.Name = "Camera"
'Built-in constant ppAnimateByParagraph has been replaced by its value 0.
.TextUnitEffect = 0
'Built-in constant ppEffectFlyFromRight has been replaced by its value 3331.

.EntryEffect = 3331

End With

End With

 

'REFER THE SECOND SHAPE IN SECOND SLIDE:

With oSlidePP.Shapes(2)

'use the TextRange.ParagraphFormat Property to do paragraph formatting for the specified text.
'this shape is the bulleted text area, here we are changing the bullet type:
'Built-in constant ppBulletNumbered has been replaced by its value 2.
.TextFrame.TextRange.ParagraphFormat.Bullet.Type = 2
Set ws = ThisWorkbook.Sheets("Sheet1")

.TextFrame.TextRange.Text = Trim(ws.Range("A1")) & Chr(13) & Chr(13) & Trim(ws.Range("A2")) & Chr(13) & Chr(13) & Trim(ws.Range("A3")) & Chr(13) & Chr(13) & Trim(ws.Range("A4")) & Chr(13) & Chr(13) & Trim(ws.Range("A5")) & Chr(13) & Chr(13) & Trim(ws.Range("A6"))
.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 18
.TextFrame.TextRange.Font.Color = RGB(0, 0, 255)
'Built-in constant msoTrue has been replaced by its value -1.
.TextEffect.FontBold = -1

With .AnimationSettings

'Built-in constant ppAdvanceOnTime has been replaced by its value 2.
.AdvanceMode = 2
.AdvanceTime = 1
.SoundEffect.Name = "Camera"
'Built-in constant ppAnimateByParagraph has been replaced by its value 0.
.TextUnitEffect = 0
'Built-in constant ppAnimateBySecondLevel has been replaced by its value 2.
.TextLevelEffect = 2
'Built-in constant ppEffectFlyFromRight has been replaced by its value 3331.

.EntryEffect = 3331

End With

End With


'-------------------------
'ADD THIRD SLIDE:
lSlideCount = oPrsntPP.Slides.Count

'Built-in constant ppLayoutTitleOnly has been replaced by its value 11.
Set oSlidePP = oPrsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=11)

 

With oSlidePP.SlideShowTransition

'Built-in constant ppTransitionSpeedFast has been replaced by its value 3.
.Speed = 3
'Built-in constant ppEffectWheel1Spoke has been replaced by its value 3857.
.EntryEffect = 3857
'Built-in constant msoTrue has been replaced by its value -1.
.AdvanceOnTime = -1

.AdvanceTime = dtSlideAdvanceTime

End With


oSlidePP.Shapes.Title.TextFrame.TextRange.Text = "Sales Performance - 2012"

 

'REFER THE FIRST SHAPE IN THIRD SLIDE - SET TITLE:

With oSlidePP.Shapes(1)

.TextFrame.TextRange.Text = "Sales and Profitability Chart"
.TextFrame.TextRange.Font.Name = "Verdana"
.TextFrame.TextRange.Font.Color = vbYellow
.TextFrame.TextRange.Font.Size = 20
'Built-in constant msoTrue has been replaced by its value -1.

.TextEffect.FontBold = -1

With .AnimationSettings

'Built-in constant ppAdvanceOnTime has been replaced by its value 2.
.AdvanceMode = 2
.SoundEffect.Name = "Camera"
'Built-in constant ppAnimateByParagraph has been replaced by its value 0.
.TextUnitEffect = 0
'Built-in constant ppEffectFlyFromTop has been replaced by its value 3330.

.EntryEffect = 3330

End With

End With


'ADD SECOND SHAPE, AS CHART, IN THIRD SLIDE:

ThisWorkbook.Worksheets("Sheet2").ChartObjects("SalesPerfChart").Copy
oSlidePP.Shapes.Paste

Set oShapePP = oSlidePP.Shapes(oSlidePP.Shapes.Count)

 

With oShapePP

.Top = oSlidePP.Shapes(oSlidePP.Shapes.Count - 1).Top + oSlidePP.Shapes(oSlidePP.Shapes.Count - 1).Height + 25
.Left = oSlidePP.Shapes(oSlidePP.Shapes.Count - 1).Left
.Width = oSlidePP.Shapes(oSlidePP.Shapes.Count - 1).Width

.Height = 300

With .AnimationSettings

'Built-in constant ppEffectZoomIn has been replaced by its value 3345.
.EntryEffect = 3345
'Built-in constant ppAdvanceOnTime has been replaced by its value 2.
.AdvanceMode = 2
.AdvanceTime = 2
.SoundEffect.Name = "Chime"
'Built-in constant ppAnimateByParagraph has been replaced by its value 0.

.TextUnitEffect = 0

End With

End With


'-------------------------
'ADD FOURTH SLIDE:
lSlideCount = oPrsntPP.Slides.Count

'Being a blank slide (ppLayoutBlank), it has no shapes, you can add your shapes to the slide:
'Built-in constant ppLayoutBlank has been replaced by its value 12.
Set oSlidePP = oPrsntPP.Slides.Add(Index:=lSlideCount + 1, Layout:=12)

'You use the SlideMaster Property to set the background gradient for all slides, as shown in the beginning. If you want to set the background for an individual slide without affecting other slides, you need to set the FollowMasterBackground property of a slide to False, as shown below.
oSlidePP.FollowMasterBackground = False
oSlidePP.Background.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, PresetGradientType:=msoGradientCalmWater

 

With oSlidePP.SlideShowTransition

'Built-in constant ppTransitionSpeedSlow has been replaced by its value 1.
.Speed = 1
'Built-in constant ppEffectBoxOut has been replaced by its value 3073.
.EntryEffect = 3073
'Built-in constant msoTrue has been replaced by its value -1.
.AdvanceOnTime = -1

.AdvanceTime = dtSlideAdvanceTime

End With


'create a new shape in the slide:
Set oShapePP = oSlidePP.Shapes.AddShape(Type:=msoShapeRectangle, Left:=10, Top:=10, Width:=470, Height:=250)

'activate the new slide:
oApplPP.ActiveWindow.View.GotoSlide oPrsntPP.Slides.Count
'select shape to align:
oShapePP.Select
'aligning a shape(s):
'ShapeRange object represents all slide objects selected in the slide. Align (ie. ShapeRange.Align Method) works with ShapeRange, and not with a Shape, hence selection of a shape is required to use the Selection.ShapeRange Property as below.
'Built-in constants msoAlignCenters & msoTrue have been replaced by their numerical values 1 and -1:
oApplPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, -1
'Built-in constants msoAlignMiddles & msoTrue have been replaced by their numerical values 4 and -1:
oApplPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, -1

'Aligns all shapes in the slide:
'Built-in constants msoAlignCenters & msoTrue have been replaced by their numerical values 1 and -1:
'oSlidePP.Shapes.Range.Align 1, -1

'vertical alignment of textframe in the selected shape:
'Built-in constant msoAnchorTop has been replaced by its value 1.
oApplPP.ActiveWindow.Selection.ShapeRange.TextFrame2.VerticalAnchor = 1

 

'REFER THE FIRST SHAPE IN FOURTH SLIDE:

With oShapePP

'Chr(32) adds a space; Chr(13) is carriage return and has the effect of creating a new paragraph:
.TextFrame.TextRange.Text = Chr(32) & "We hope to Continue this Strong Performance" & Chr(13) & Chr(13) & Chr(32) & "Thank You Ladies & Gentlemen" & Chr(13) & Chr(13) & Chr(32) & "End of Presentation"

'Built-in constant ppAlignJustify has been replaced by its value 4.
.TextFrame.TextRange.ParagraphFormat.Alignment = 4
'Add bullets to all text in the range. Built-in constant ppBulletUnnumbered has been replaced by its value 1.
.TextFrame.TextRange.ParagraphFormat.Bullet.Type = 1
'To add bullets to the first paragraph. Built-in constant ppBulletUnnumbered has been replaced by its value 1.:
'.TextFrame.TextRange.Paragraphs(1).ParagraphFormat.Bullet.Type = 1
'to add bullets to the last paragraph:
'.TextFrame.TextRange.Paragraphs(.TextFrame.TextRange.Paragraphs.Count).ParagraphFormat.Bullet.Character = 8226
'indent last para:
.TextFrame.TextRange.Paragraphs(3).IndentLevel = 2
.TextFrame.TextRange.Paragraphs(.TextFrame.TextRange.Paragraphs.Count).IndentLevel = 3
.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 20
.TextFrame.TextRange.Font.Color = RGB(0, 255, 0)
'Built-in constant msoTrue has been replaced by its value -1:

.TextEffect.FontBold = -1

With .AnimationSettings

'Built-in constant ppAdvanceOnTime has been replaced by its value 2:
.AdvanceMode = 2
'You can assign different sound effects for each shape viz. Chime, Appluase, etc. Play the powerpoint sound named Applause:
.SoundEffect.Name = "Applause"
'Built-in constant ppAnimateByParagraph has been replaced by its value 0:
.TextUnitEffect = 0
'Built-in constant ppAnimateBySecondLevel has been replaced by its value 2.
.TextLevelEffect = 2
'Built-in constant ppEffectCheckerboardAcross has been replaced by its value 1025:

.EntryEffect = 1025

End With

End With


'-------------------------
'FONT SETTINGS IN FIRST SLIDE:

'refer shape by its name:
oPrsntPP.Slides(1).Shapes("Company").TextFrame.TextRange.Paragraphs(1).Lines(1).Font.Italic = True
'format as italic the second and third lines of the first paragraph in shape three on slide one in the current powerpoint presentation:
oPrsntPP.Slides(1).Shapes(3).TextFrame.TextRange.Paragraphs(1).Lines(2, 3).Font.Color = vbBlue
oPrsntPP.Slides(1).Shapes(3).TextFrame.TextRange.Paragraphs(3).Lines(1).Font.Underline = True

'-------------------------
'SAVE PRESENTATION, AND RUN THE SLIDE SHOW:

'save the presentation:
oPrsntPP.Save

 

'minimize Excel window:
'Built-in constant xlMinimized has been replaced by its value -4140.
Application.WindowState = -4140

lSlideCount = oPrsntPP.Slides.Count
Dim iSlideIndexPP As Integer

'The SlideShowSettings.Run Method runs a slide show. Use the Run method of the SlideShowSettings to create a new Slide Show Window, and then use the View property to return the Slide Show View (ie. the view in a slide show window).
'To set variable of the SlideShowSettings.Run.View object, use the following code. Note that this creates a new slide show window.
'Set oSlideShowPP = oPrsntPP.SlideShowSettings.run.View

 

'the slide show will run till the end of all slides:
For iSlideIndexPP = 1 To lSlideCount

'this will avoid an error message while running the slide show and will exit the For...Next loop:

On Error GoTo ErrorLine

If iSlideIndexPP = 1 Then

'the slide show window view would have repeated if the object variable oSlideShowPP had been set before the For...Next statement:

Set oSlideShowPP = oPrsntPP.SlideShowSettings.run.View

Else

oSlideShowPP.GotoSlide iSlideIndexPP

End If

'Insert a delay time before continuing to next slide. This will ensure that the slide show remains visible while running, else the slides will not be able to hold view.
'The time set of 20 seconds is equivalent to (it is necessary to synchronize) the standard SlideShowTransition.AdvanceTime set for all slides.

Application.Wait Now + TimeValue("00:00:20")

Next iSlideIndexPP

 
'Note that the slide show could have also been run using the SlideShowSettings.Run method and the SlideShowView.State Property as shown in the previous example, but the code will not work in PowerPoint 2007 with Late Binding. In the code line -- Do Until oSlideShowPP.State = ppSlideShowDone -- the built-in constant ppSlideShowDone will need to be replaced by its value of 5 while using Late Binding, which fails while running the code.

ErrorLine:
'though this does not actually save the presentation, it avoids a dialog box asking to save changes:
oPrsntPP.Saved = True
oPrsntPP.Close
oApplPP.Quit
Exit Sub

'-------------------------
'CLOSE PRESENTATION, CLEAR VARIABLES AND QUIT APPLICATION:

 

'though this does not actually save the presentation, it avoids a dialog box asking to save changes:
oPrsntPP.Saved = True


'close presentation
oPrsntPP.Close

'clear the variables:
Set oShapePP = Nothing
Set oSlidePP = Nothing
Set oPrsntPP = Nothing
Set oSlideShowPP = Nothing
    
'quit PowerPoint application:
oApplPP.Quit

'clear the variable:
Set oApplPP = Nothing


End Sub