G
Guest
I am trying to write animation sequences to show flowpaths on a system
drawing for a power plant. Due to the large number of effects 300+ on one
slide, I decided to animate in pieces, write out the parameters to a file,
combine the pieces, and read them back in to the slide. This way I can
modify / correct mistakes. The problem that I am having is writting out the
line / fill color for shape reliably and reading them back in to the right
property. Any help is apreciated. I can download the powerpoint if I can
tell were to put it. About 520k for the one slide.
' I use PrintSequence to write parameters to file but have trouble writting
some of the color
' codes. It only works for a few shapes and animations. Also can not read
them in reliable.
Sub PrintSequence()
Dim objSequence As Sequence
Dim objShape1 As Shape
Dim objShape2 As Shape
Dim objEffect1 As Effect
Dim C As Integer
Dim Color As Long
Dim lngReturn As Long
Dim FileName As String
Dim Direction As Integer
FileName = "C:\temp1\outputfile.txt"
Open FileName For Output As #1
With ActivePresentation.Slides(1)
Set objSequence =
ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Item(1) 'Change
item index to select
'Set objSequence = .TimeLine.MainSequence 'Un-Comment to read main sequence
For C = 1 To objSequence.Count
Set objEffect1 = objSequence.Item(C)
With objEffect1
If .EffectType = msoAnimEffectWipe Then
Direction = .EffectParameters.Direction
Else
Direction = 0
End If
Select Case .EffectType
Case msoAnimEffectChangeLineColor
' If (.Index <> 56) And (.Index <> 58) Then 'index 56 & 58 fault in
sequence 2
Color = .EffectParameters.Color2.RGB
' Else
' Color = 0
' End If
Case msoAnimEffectChangeFillColor
Color = .Shape.Fill.BackColor.RGB
Case Else
Color = 0
End Select
Write #1, .Shape.Name; .Index; .EffectType; .Timing.Duration; Direction; _
.Timing.TriggerType; .Exit; Color; .DisplayName
End With
Next C
End With
Close #1
lngReturn = Shell("NOTEPAD.EXE " & FileName, vbNormalFocus)
End Sub
'I take the output file from above, rename, edit and read it back in to
modify my sequences
' do to the large number of animations on some pages. The presentation is
270+ slides.
' The system supplies makeup water to the reactor and is used in training
new operators.
' may need to change file paths.
Sub ReadSequences()
Dim objSequence As Sequence
Dim objShape1 As Shape
Dim objShape2 As Shape
Dim objEffect1 As Effect
Dim ShapeName As String
Dim Index, EffectType, Speed, Direction, Start, ExitEffect As Integer
Dim Color As Long
With ActivePresentation.Slides(233)
Set objSequence = .TimeLine.InteractiveSequences.Add(1)
Set objShape1 = .Shapes("Normal")
Open "C:\temp1\inputfile.txt" For Input As #1
Do While Not EOF(1)
Input #1, ShapeName, Index, EffectType, Speed, Direction, Start,
ExitEffect, Color
Set objShape2 = .Shapes(ShapeName)
With objSequence
Set objEffect1 = .AddEffect(Shape:=objShape2, _
Effectid:=EffectType, _
Trigger:=Start)
With objEffect1
If EffectType = 22 Then
.EffectParameters.Direction = Direction
End If
If (EffectType <> 54) And (EffectType <> 60) Then
.Exit = ExitEffect
End If
.Timing.Duration = Speed
.Timing.TriggerShape = objShape1
Select Case EffectType
Case msoAnimEffectChangeLineColor
.EffectParameters.Color2 = Color
Case msoAnimEffectChangeFillColor
.Shape.Fill.BackColor.RGB = Color
Case Else
Color = 0
End Select
End With
End With
Loop
End With
Close #1
End Sub
drawing for a power plant. Due to the large number of effects 300+ on one
slide, I decided to animate in pieces, write out the parameters to a file,
combine the pieces, and read them back in to the slide. This way I can
modify / correct mistakes. The problem that I am having is writting out the
line / fill color for shape reliably and reading them back in to the right
property. Any help is apreciated. I can download the powerpoint if I can
tell were to put it. About 520k for the one slide.
' I use PrintSequence to write parameters to file but have trouble writting
some of the color
' codes. It only works for a few shapes and animations. Also can not read
them in reliable.
Sub PrintSequence()
Dim objSequence As Sequence
Dim objShape1 As Shape
Dim objShape2 As Shape
Dim objEffect1 As Effect
Dim C As Integer
Dim Color As Long
Dim lngReturn As Long
Dim FileName As String
Dim Direction As Integer
FileName = "C:\temp1\outputfile.txt"
Open FileName For Output As #1
With ActivePresentation.Slides(1)
Set objSequence =
ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Item(1) 'Change
item index to select
'Set objSequence = .TimeLine.MainSequence 'Un-Comment to read main sequence
For C = 1 To objSequence.Count
Set objEffect1 = objSequence.Item(C)
With objEffect1
If .EffectType = msoAnimEffectWipe Then
Direction = .EffectParameters.Direction
Else
Direction = 0
End If
Select Case .EffectType
Case msoAnimEffectChangeLineColor
' If (.Index <> 56) And (.Index <> 58) Then 'index 56 & 58 fault in
sequence 2
Color = .EffectParameters.Color2.RGB
' Else
' Color = 0
' End If
Case msoAnimEffectChangeFillColor
Color = .Shape.Fill.BackColor.RGB
Case Else
Color = 0
End Select
Write #1, .Shape.Name; .Index; .EffectType; .Timing.Duration; Direction; _
.Timing.TriggerType; .Exit; Color; .DisplayName
End With
Next C
End With
Close #1
lngReturn = Shell("NOTEPAD.EXE " & FileName, vbNormalFocus)
End Sub
'I take the output file from above, rename, edit and read it back in to
modify my sequences
' do to the large number of animations on some pages. The presentation is
270+ slides.
' The system supplies makeup water to the reactor and is used in training
new operators.
' may need to change file paths.
Sub ReadSequences()
Dim objSequence As Sequence
Dim objShape1 As Shape
Dim objShape2 As Shape
Dim objEffect1 As Effect
Dim ShapeName As String
Dim Index, EffectType, Speed, Direction, Start, ExitEffect As Integer
Dim Color As Long
With ActivePresentation.Slides(233)
Set objSequence = .TimeLine.InteractiveSequences.Add(1)
Set objShape1 = .Shapes("Normal")
Open "C:\temp1\inputfile.txt" For Input As #1
Do While Not EOF(1)
Input #1, ShapeName, Index, EffectType, Speed, Direction, Start,
ExitEffect, Color
Set objShape2 = .Shapes(ShapeName)
With objSequence
Set objEffect1 = .AddEffect(Shape:=objShape2, _
Effectid:=EffectType, _
Trigger:=Start)
With objEffect1
If EffectType = 22 Then
.EffectParameters.Direction = Direction
End If
If (EffectType <> 54) And (EffectType <> 60) Then
.Exit = ExitEffect
End If
.Timing.Duration = Speed
.Timing.TriggerShape = objShape1
Select Case EffectType
Case msoAnimEffectChangeLineColor
.EffectParameters.Color2 = Color
Case msoAnimEffectChangeFillColor
.Shape.Fill.BackColor.RGB = Color
Case Else
Color = 0
End Select
End With
End With
Loop
End With
Close #1
End Sub