Animating multiple shapes using Timeline Object.

T

technoknight

I am here posting the code. I have made two functions: one to create the
textbox and one to create the rectangles.

Here is the code to create the textbox
-----------------------------------------------------------------------------------------------
Function CreateTextBox(ByVal sld As Object, TextProperty As TextProperty_,
Optional Zorder_ As Long = msoSendToBack) As Long

On Error Resume Next
gShapeCounter = gShapeCounter + 1

With TextProperty
Set newshp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, .X,
..Y, .Width, .Height)
CreateTextBox = .Height 'This is specific to our requirements. So u
can ignore this line
End With

With newshp

With .TextFrame.TextRange
.Text = TextProperty.Text
.Font.Name = TextProperty.Font
.Font.Size = TextProperty.FontSize
.ParagraphFormat.Alignment = TextProperty.TextAlignment
End With

.TextFrame.AutoSize = ppAutoSizeShapeToFitText
CreateTextBox = .TextFrame.TextRange.BoundHeight


.Name = "CustText" & gShapeCounter

With .AnimationSettings

.EntryEffect = TextProperty.EntryEffect
.SoundEffect.ImportFromFile frmAnimator.gSound

If TextProperty.DimOnNext Then
.AfterEffect = ppAfterEffectDim
.DimColor.RGB = RGB(220, 220, 220)
End If
End With
End With
Exit Function
err_handle:
End Functio
-----------------------------------------------------------------------------------------




And here is the code to create the rectangles
-----------------------------------------------------------------------------------------------
Function CreateRect(ByVal sld As Object, TextProperty As TextProperty_,
Optional Zorder_ As Long = msoSendToBack)

On Error Resume Next
Dim Counter As Long


With TextProperty
gShapeCounter = gShapeCounter + 1
Set newshp = sld.Shapes.AddShape(msoShapeRectangle, .X, .Y, .Width,
..Height)
CreateRect = .Height
newshp.Name = "CustRec" & gShapeCounter
newshp.Fill.ForeColor.RGB = gRectangleBackColor
newshp.ZOrder Zorder_

End With


' With newshp
' .AdvanceMode = ppAdvanceModeMixed
' .AdvanceTime = 0
' .EntryEffect = TextProperty.EntryEffect
' If TextProperty.DimOnNext Then
' .AfterEffect = ppAfterEffectDim
' .DimColor.RGB = RGB(255, 255, 255)
' End If
' '.AnimationOrder = gAnimationOrderCounter

sld.TimeLine.MainSequence.AddEffect Shape:=newshp,
effectId:=msoAnimEffectFly, trigger:=msoAnimTriggerWithPrevious


' End With
Exit Function
err_handle:

End Functio
----------------------------------------------------------------------------------------------

We are actually using these functions somewhere else so please don't worry
about the parameters. We are calling the createtextbox function first and
then the createrect function. We are calling these funtions(together) a few
number of times in our main function. When the first textbox+rectangle is
created then the rectangles' triggereffect is msoAnimTriggerWithPrevious. But
when the next textbox+rectangle is created the triggereffect for the previous
rectangle changes to msoAnimTriggerAfterPrevious. And this keeps on till the
last rectanlge is created. So, in this case, only the last rectangle gets the
triggereffect=msoAnimTriggerWithPrevious. All the previous ones get
msoAnimTriggeAfterPrevious.


One more problem: Suppose I want my rectangle to Flyin From left
(simultaneously with the text). Now when I use .AddEffect then there is no
effect ID which corresponds to flyinfromleft. There is msoAnimEffectFly but
it won't animate the rectangle from left. So what can be done in this case
when we want an animation type which is not defined for the EffectID????

Can Anyone help me???

Thanks.
 
H

Hans W. Hofmann

I am here posting the code. I have made two functions: one to create the
textbox and one to create the rectangles.
Your code is correct so far.
Nothing intends whats going on to change the trigger behavior. You
have to single step the whole code what does change the trigger of
your shapes. But why adding a special textbox? Every Autoform as a
rectangle has its own textframe you can use.
BTW: You can't pass a object variable ByVal it is a pointer to the
object this means it is ByRef per design. And why handle sld as Object
it is slide at last...


Gruß HW


WebSite Excelenzen & Powerpoint interaktiv: www.lemitec.de/public
Events zu PowerPoint:VBA Workshop: http://www.ppt-user.de
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top