CODEWITHSUNDEEP
vbaanimationpowerpointpowerpoint-2016
Laminator
Laminator

Reputation: 11

Adding sound effects to macro-generated PPT slides causes animations to change apparently randomly

I'm generating a largish presentation to run during a game showing players what stages they should have reached (the game isn't important). Each slide has a hollow circle/donut sweeping out an overall time while pictures appear showing the stage players should have reached. (The slides are being macro-generated as there are many variations, differing only slightly, including in timing details.)

When there are no sound effects, the macro works perfectly. When a sound effect is added to any .effect, the entire animation sequence is changed significantly and incorrectly. Timings that are assigned to start "With Previous" become "After Previous", durations are changed, the fade effect is lost. I've tried changing the sequence of the effect attribute assignments, adding a dummy shape and assigning the sound to that, no success.

Copying and running this simplified version demonstrates what happens - the same sub is used to generate two single-slide presentations on the desktop which should be the same other than sound effects, but are not.

Const CycleTime = 10
' CycleTime = Seconds for which the circular sweep should run;
' A shape appears for the first half then fades to be replaced by a second shape.
Dim fn$
Public Sub MakeTestPresentations()
    fn$ = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "Test@" & Format(Now(), "hhmmss")
    Call MakeASlide(UsingSound:=False)
    Call MakeASlide(UsingSound:=True)
Exit Sub
End Sub
Sub MakeASlide(ByVal UsingSound As Boolean)
Dim sldThis As Slide, swp As Shape, shp1 As Shape, shp2 As Shape
'   New blank presentation
    Set pptSource = Presentations.Add
'   Add a blank slide
    Set sldThis = pptSource.Slides.Add(Index:=1, Layout:=ppLayoutBlank)
'   Add a donut which will be the overall timer, set to sweep in CycleTime seconds
    Set swp = sldThis.Shapes.AddShape(msoShapeDonut, 525, 83, 369, 369)
    swp.Fill.ForeColor.RGB = RGB(0, 0, 128)
    sldThis.TimeLine.MainSequence.AddEffect(Shape:=swp, effectId:=msoAnimEffectWheel, Trigger:=msoAnimTriggerWithPrevious).Timing.Duration = CycleTime
'   Add a shape which should appear for the first half of the cycle, fading in & out
    Set shp1 = sldThis.Shapes.AddShape(msoShapeCloud, 83, 83, 369, 369)
    shp1.Fill.ForeColor.RGB = RGB(0, 255, 0)
    With sldThis.TimeLine.MainSequence.AddEffect(Shape:=shp1, effectId:=msoAnimEffectFade, Trigger:=msoAnimTriggerWithPrevious)
        .Timing.TriggerDelayTime = 0
        .Timing.Duration = CycleTime / 2
        If UsingSound Then .EffectInformation.SoundEffect.Name = "Laser"
    End With
    With sldThis.TimeLine.MainSequence.AddEffect(Shape:=shp1, effectId:=msoAnimEffectFade, Trigger:=msoAnimTriggerWithPrevious)
        .Timing.TriggerDelayTime = CycleTime / 2
        .Exit = True
    End With
'   Add a shape which should appear for the second half of the cycle, fading in & out
    Set shp2 = sldThis.Shapes.AddShape(msoShape16pointStar, 83, 83, 369, 369)
    shp2.Fill.ForeColor.RGB = RGB(255, 0, 0)
    With sldThis.TimeLine.MainSequence.AddEffect(Shape:=shp2, effectId:=msoAnimEffectFade, Trigger:=msoAnimTriggerWithPrevious)
        .Timing.TriggerDelayTime = CycleTime / 2
        .Timing.Duration = CycleTime / 2
        If UsingSound Then .EffectInformation.SoundEffect.Name = "Drum Roll"
    End With
    With sldThis.TimeLine.MainSequence.AddEffect(Shape:=shp2, effectId:=msoAnimEffectFade, Trigger:=msoAnimTriggerWithPrevious)
        .Timing.TriggerDelayTime = CycleTime
        .Exit = True
    End With
'   Save the presentation
    pptSource.SaveCopyAs fn$ & IIf(UsingSound, " (WITH Sound)", " (NO Sound)"), ppSaveAsDefault
    pptSource.Close
Exit Sub
End Sub

Upvotes: 1

Views: 279

Answers (1)

Bes Gh
Bes Gh

Reputation: 23

I have a simple sub for adding background music:

Sub insert_rnd_back(Track As String)
Dim oSlide As Slide
Dim oShp As Shape
Dim oEffect As Effect

Set oSlide = ActivePresentation.Slides(1)
Set oShp = oSlide.Shapes.AddMediaObject2(Track, True, False, 10, 610)

With oShp.AnimationSettings.PlaySettings
    .PlayOnEntry = msoTrue
    .PauseAnimation = msoFalse
    .StopAfterSlides = ActivePresentation.Slides.Count
    .LoopUntilStopped = msoTrue
    .HideWhileNotPlaying = msoTrue
    .RewindMovie = msoTrue
End With
oShp.MediaFormat.Volume = 0.5
End Sub

And I am adding sounds to individual shapes with this:

Dim oShp As Shape
Dim oEffect As Effect
Set oShp = ActivePresentation.Slides(sld).Shapes.AddMediaObject2( _
                    aud & sityvebi(sld) & ".wav", True, False, 100, 610)
Set oEffect = ActivePresentation.Slides(sld).TimeLine.MainSequence.AddEffect( _
                    oShp, msoAnimEffectMediaPlay, , msoAnimTriggerAfterPrevious)
oShp.MediaFormat.Volume = 1

Upvotes: 0

Related Questions