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