The code is actually very big. We have lots of funtions and modules in VB.
But I am trying to post the relevant code:
--------------------------------------------------------------------------------------------
Sub ApplyEffect2002Effects(NewShape As Object, TextProperty As
TextProperty_, Optional EffectName As String = "")
Dim effect_ As Object
If EffectName = "" Then
EffectName = gAnimationStyleName
End If
With TextProperty.ParentSlide.TimeLine
Set effect_ = .MainSequence.AddEffect(Shape:=NewShape, effectId:=0)
Select Case EffectName
Case "EffectsRectangleFade"
EffectsRectangleFade effect_
Case "EffectsTextFade"
EffectsTextFade effect_
Case "Style1"
EffectsSlide1 effect_, gAnimationOrderCounter
Case "Style2"
EffectsSlide2 effect_, gAnimationOrderCounter
Case "Style3"
EffectsSlide3 effect_, gAnimationOrderCounter
Case "Style4"
EffectsSlide4 effect_, gAnimationOrderCounter
Case "Style5"
EffectsSlide5 effect_, gAnimationOrderCounter
Case "Style6"
EffectsSlide6 effect_, gAnimationOrderCounter
Case "Style7"
EffectsSlide7 effect_, gAnimationOrderCounter
Case "Style8"
EffectsSlide8 effect_, gAnimationOrderCounter
Case "Style9"
EffectsSlide9 effect_, gAnimationOrderCounter
Case "Style10"
EffectsSlide10 effect_, gAnimationOrderCounter
Case "Style11"
EffectsSlide11 effect_, gAnimationOrderCounter
End Select
End With
------------------------------------------------------------------------------------------
Here is the Module which defines EffectSlide<slidenumber> functions
---------------------------------
Option Explicit
Sub EffectsTextFade(effect_ As Object)
On Error Resume Next
With effect_
.EffectInformation.Dim.schemecolor = 8
.Timing.TriggerType = 2
.Timing.TriggerDelayTime = 0
.Timing.Speed = 5
.EffectType = 56 'Const msoAnimEffectChangeFontColor = 56
End With
End Sub
Sub EffectsRectangleFade(effect_ As Object)
On Error Resume Next
With effect_
.EffectInformation.Dim.schemecolor = 8
.Timing.TriggerType = 2
.Timing.TriggerDelayTime = 0
.Timing.Speed = 5
.EffectType = 10
.Exit = msoTrue
End With
End Sub
'Stretch Across: Slide1
Sub EffectsSlide1(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = 17
.EffectParameters.Direction = 18
End With
End Sub
'Strips DownLeft Slide 2
Sub EffectsSlide2(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = 18
.EffectParamters.Direction = 9
End With
End Sub
'Stretch fromBottom Slide 3
Sub EffectsSlide3(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = 17
.EffectParameters.Direction = 11
End With
End Sub
'Stretch from top Slide 3A
Sub EffectsSlide4(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
'.Timing.TriggerType = 2
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = 17
.EffectParameters.Direction = 10
End With
End Sub
'Rect: Fly from left & Text: Fade - Slide 4
Sub EffectsSlide5(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = IIf(InStr(effect_.Shape.Name, "Text"), 10, 2)
.EffectParameters.Direction = IIf(InStr(effect_.Shape.Name, "Text"),
0, 4)
' If ForText Then
' .Timing.TriggerType = 1
' .Timing.TriggerDelayTime = 0
' .EffectType = 10
' Else
' .Timing.TriggerType = 2
' .Timing.TriggerDelayTime = 0
' .EffectType = 2
' .EffectParameters.Direction = 4
' End If
End With
End Sub
'Rect: Fly from Left & Text: Unfold - Slide 5
Sub EffectsSlide6(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = IIf(InStr(effect_.Shape.Name, "Text"), 37, 2)
.EffectParameters.Direction = IIf(InStr(effect_.Shape.Name, "Text"),
0, 4)
' If ForText Then
' .Timing.TriggerType = 1
' .Timing.TriggerDelayTime = 0
' .EffectType = 37
' Else
' .Timing.TriggerType = 2
' .Timing.TriggerDelayTime = 0
' .EffectType = 2
' .EffectParameters.Direction = 4
'
' End If
End With
End Sub
'ZoomIN - Slide 6
Sub EffectsSlide7(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = 23
.EffectParameters.Direction = 19
End With
End Sub
'Rect: Fly from Left & Text: None - Slide 7
Sub EffectsSlide8(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = IIf(InStr(effect_.Shape.Name, "Text"), 0, 2)
.EffectParameters.Direction = IIf(InStr(effect_.Shape.Name, "Text"),
0, 4)
End With
End Sub
'Rect: Fly from Right & Text: None - Slide 7A
Sub EffectsSlide9(effect_ As Object, Index As Long, Optional ForText As Long
= 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = IIf(InStr(effect_.Shape.Name, "Text"), 0, 2)
.EffectParameters.Direction = IIf(InStr(effect_.Shape.Name, "Text"),
0, 2)
End With
End Sub
'Fly from Top - Slide 8
Sub EffectsSlide10(effect_ As Object, Index As Long, Optional ForText As
Long = 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = IIf(InStr(effect_.Shape.Name, "Text"), 2, 2)
.EffectParameters.Direction = IIf(InStr(effect_.Shape.Name, "Text"),
10, 10)
End With
End Sub
'Fly from Left - Slide 8a
Sub EffectsSlide11(effect_ As Object, Index As Long, Optional ForText As
Long = 1)
On Error Resume Next
With effect_
.Timing.TriggerType = IIf(InStr(effect_.Shape.Name, "Text"), 1, 2)
.Timing.TriggerDelayTime = 0
.EffectType = IIf(InStr(effect_.Shape.Name, "Text"), 2, 2)
.EffectParameters.Direction = 4 ' IIf(InStr(effect_.Shape.Name,
"Text"), 4, 4)
End With
End Sub
---------------------------------------------------------------------------------------
I hope u got the code. Here is one ApplyEffects2002 function which checked
the type of animation i want to put and then applies the effects using
Timline ANimations (We use timeline in 2002& above becoz Animationsettings
work for 2000 & earlier). Now we need to add sound to every effect.
Thanks.
Echo S said:
How did you add sound?
(Is "Timeline" an add-in for PPT, or do you just mean that you're using
PPT's custom animation and showing the timeline so you can see what's
happening?)
Oh, wait. You said "into PPT automation." You mean you're using VBA, right?
You'll need to post the relevant code.
--
Echo [MS PPT MVP]
http://www.echosvoice.com
technoknight said:
I m into powerpoint automation. I m animating few shapes simultaneously using
Timeline for powerpoint 2002. But i have problems adding sound effects to the
animations. I have two shapes: rectangle and text. Both of them get animated
together. But when I try to add sound they come one after another. Can
someone help me in adding soundeffect without effecting the simultaneous
animations of rectangle and the text?
Thanks.
