S
Silvester
I am looking to automate powerpoint from Access uing VBA code.
I am not sure how to animate shapes and animation sequencing.
I would like to display a slide and then animate a rectangle to crawl in
from the bottom, some text to crawl right to left & disappear off the left,
rectangle to crawl out downwards.
I found this code on
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnofftalk/html/office02072002.asp
Can someone please help me doctor it to suit ? I do not need the
interactivity/user click triggers...
Thanks very much...
Public Sub CreateAnimatedPresentation()
' Purpose: Creates a PowerPoint presentation,
' adds a slide and two shapes to the slide,
' animates the shapes, and runs the slide show.
Dim ppApp As PowerPoint.Application
Dim objPres As PowerPoint.Presentation
Dim objSlide As PowerPoint.Slide
Dim objSquareShape As PowerPoint.Shape
Dim objTriangleShape As PowerPoint.Shape
Dim objSequence As PowerPoint.Sequence
Set ppApp = New PowerPoint.Application
' Create a new PowerPoint presentation.
Set objPres = ppApp.Presentations.Add
' Add a slide to the presentation.
Set objSlide = objPres.Slides.Add(Index:=1, _
Layout:=ppLayoutBlank)
' Place two shapes on the slide.
Set objSquareShape = objSlide.Shapes.AddShape _
(Type:=msoShapeRectangle, Left:=0, Top:=0, _
Width:=100, Height:=100)
Set objTriangleShape = objSlide.Shapes.AddShape _
(Type:=msoShapeRightTriangle, Left:=0, Top:=150, _
Width:=100, Height:=100)
' Add text to the shapes.
objSquareShape.TextFrame.TextRange.Text = "Click Me!"
objTriangleShape.TextFrame.TextRange.Text = "Me Too!"
' Animate the two shapes.
Set objSequence = objSlide.TimeLine.InteractiveSequences.Add _
(Index:=1)
With objSequence
.AddEffect Shape:=objSquareShape, _
effectID:=msoAnimEffectPathStairsDown, _
trigger:=msoAnimTriggerOnShapeClick
.AddEffect Shape:=objTriangleShape, _
effectID:=msoAnimEffectPathHorizontalFigure8, _
trigger:=msoAnimTriggerOnShapeClick
End With
' Save the presentation and run the slide show.
objPres.SaveAs FileName:="C:\Dancing Shapes.ppt"
objPres.SlideShowSettings.Run
End Sub
I am not sure how to animate shapes and animation sequencing.
I would like to display a slide and then animate a rectangle to crawl in
from the bottom, some text to crawl right to left & disappear off the left,
rectangle to crawl out downwards.
I found this code on
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnofftalk/html/office02072002.asp
Can someone please help me doctor it to suit ? I do not need the
interactivity/user click triggers...
Thanks very much...
Public Sub CreateAnimatedPresentation()
' Purpose: Creates a PowerPoint presentation,
' adds a slide and two shapes to the slide,
' animates the shapes, and runs the slide show.
Dim ppApp As PowerPoint.Application
Dim objPres As PowerPoint.Presentation
Dim objSlide As PowerPoint.Slide
Dim objSquareShape As PowerPoint.Shape
Dim objTriangleShape As PowerPoint.Shape
Dim objSequence As PowerPoint.Sequence
Set ppApp = New PowerPoint.Application
' Create a new PowerPoint presentation.
Set objPres = ppApp.Presentations.Add
' Add a slide to the presentation.
Set objSlide = objPres.Slides.Add(Index:=1, _
Layout:=ppLayoutBlank)
' Place two shapes on the slide.
Set objSquareShape = objSlide.Shapes.AddShape _
(Type:=msoShapeRectangle, Left:=0, Top:=0, _
Width:=100, Height:=100)
Set objTriangleShape = objSlide.Shapes.AddShape _
(Type:=msoShapeRightTriangle, Left:=0, Top:=150, _
Width:=100, Height:=100)
' Add text to the shapes.
objSquareShape.TextFrame.TextRange.Text = "Click Me!"
objTriangleShape.TextFrame.TextRange.Text = "Me Too!"
' Animate the two shapes.
Set objSequence = objSlide.TimeLine.InteractiveSequences.Add _
(Index:=1)
With objSequence
.AddEffect Shape:=objSquareShape, _
effectID:=msoAnimEffectPathStairsDown, _
trigger:=msoAnimTriggerOnShapeClick
.AddEffect Shape:=objTriangleShape, _
effectID:=msoAnimEffectPathHorizontalFigure8, _
trigger:=msoAnimTriggerOnShapeClick
End With
' Save the presentation and run the slide show.
objPres.SaveAs FileName:="C:\Dancing Shapes.ppt"
objPres.SlideShowSettings.Run
End Sub