How to animate the text & rectabgle?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

hi
i am doing simulation in Powerpoint using VB.i have made two object 1 for
rectangle & 1 for text. now wht i want is that both the text & rectangle
should come at same time though i have written the code for that but text is
coming first then the rectangle is coming.But i want that both should come
together. i have tried but cant do tht if some one has any idea abt this plz
send me the code related to that or send me the idea how to do that.
I'll be thankful...
i am using VB.
thanks
 
' ---------------------------------------------------------------
Sub CreateAnimation()
Dim oEffect As Effect
Dim oShpA As Shape
Dim oShpB As Shape
With ActivePresentation.Slides(1)
Set oShpA = .Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 100)
Set oShpB = .Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 100,
100, 100)
oShpB.TextFrame.TextRange.Text = "This is an example."
With .TimeLine.MainSequence
' Fly in on mouse click for the rectangle.
Set oEffect = .AddEffect(Shape:=oShpA, _
effectId:=msoAnimEffectFly, _
trigger:=msoAnimTriggerOnPageClick)
' Fade zoom animation on the textbox at the same time.
Set oEffect = .AddEffect(Shape:=oShpB, _
effectId:=msoAnimEffectFadedZoom, _
trigger:=msoAnimTriggerWithPrevious)
End With
End With
End Sub
' ---------------------------------------------------------------
 
Hi
Thanx for this code first.this code is working fine for one object means if
there is 1 rectangle & 1 Text.But as soon as i add another rectangle with
text then msoAnimTriggerWithPrevious changes to msoAnimTriggerAfterPrevious
so thts the problem.means it shows the effect with only last bullet the
effect with above bullet is not shown.... ,means they r comin simultaneously
not together.it shows that only last bullet is applied this effect dont know
why ???.....so plz send me some code for that or Give me some idea how to do
that.....
Thanks
Amrish
 
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 Function
-----------------------------------------------------------------------------------------




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 Function
----------------------------------------------------------------------------------------------

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????

In case U have any confusion regarding our problem then please let us know
ASAP.

Thanks for ur help.
 

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

Back
Top