Results 1 to 3 of 3

Thread: Replace audio file in powerpoint

  1. #1
    Banned VBAX Regular
    Joined
    Sep 2020
    Posts
    15
    Location

    Replace audio file in powerpoint

    Need a little help.
    I have two slides with animations & in slide(2) have an audio file.I want to replace this audio file. When I use below code I replaced the audio file successfully but lost slide(2) animation.I can not configure it out.Any other solution will be appreciated.

    Option Explicit
    
    Sub ReplaceMediaFormat()
        Dim sld As Slide
        Dim newShp As Shape
        Dim shp As Shape
        Dim mf As MediaFormat
        Dim path As String
        Dim fDialog As FileDialog
        Dim filepath As String
        MsgBox "Please select/browse audio-background file from your computer! "
        Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
        ' Optional: FileDialog properties
        fDialog.AllowMultiSelect = False
        fDialog.Title = "Select a Audio file"
        fDialog.InitialFileName = "C:"
        ' Optional: Add filters
        fDialog.Filters.Clear
        fDialog.Filters.Add "Audio files", "*.mp3"
        fDialog.Filters.Add "All files", "*.*"
        ' Show the dialog. -1 means success!
        If fDialog.Show = -1 Then
            filepath = fDialog.SelectedItems(1)
        Else
        End If
        Set sld = ActivePresentation.Slides(2)
        Set shp = sld.Shapes("bg_music")
        Set mf = shp.MediaFormat
        Set newShp = sld.Shapes.AddMediaObject2(filepath)
        With newShp
             .Top = shp.Top
             .Left = shp.Left
             .Width = shp.Width
             .Height = shp.Height
        End With
        With newShp.MediaFormat
             .StartPoint = mf.StartPoint
             .EndPoint = mf.EndPoint
             .FadeInDuration = mf.FadeInDuration
             .FadeOutDuration = mf.FadeOutDuration
             .Muted = mf.Muted
             .Volume = mf.Volume
         End With
        shp.Delete
        Dim eff As Effect
        Set eff = sld.TimeLine.MainSequence.AddEffect(newShp, msoAnimEffectMediaPlay, trigger:=msoAnimTriggerWithPrevious)
        With newShp.AnimationSettings.PlaySettings
             .LoopUntilStopped = msoTrue
             .PauseAnimation = msoFalse
             .PlayOnEntry = msoTrue
             .RewindMovie = msoFalse
             .StopAfterSlides = 999
             .HideWhileNotPlaying = msoTrue
        End With
        newShp.Name = "bg_music"
    End Sub
    Last edited by Aussiebear; 05-16-2025 at 12:51 PM. Reason: Added CODE tags

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,096
    Location
    You might want to explain what 'but lost slide(2) animation' means. What animation was lost.

    Normally you should not mix timeline animation with the legacy animation settings but in this instance it should work.


    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    Banned VBAX Regular
    Joined
    Sep 2020
    Posts
    15
    Location
    Thanks sir for your reply.

    I am using one animation on a shape(graphic) like

    Set gshp = osld.Shapes("graphic" & j)
    If gshp Is Nothing Then GoTo err
    gshp.PickupAnimation
    gshp.PickUp
    ' Capture properties of exisitng graphic such as location and size
    With gshp
        t = .Top
        l = .Left
        h = .Height
        w = .Width
    End With
    Set graphicShp = osld.Shapes.AddShape(gshp.AutoShapeType, l, t, w, h)
    If gshp.HasTextFrame Then
        graphicShp.TextFrame.TextRange = gshp.TextFrame.TextRange
    End If
    graphicShp.Apply
    graphicShp.ApplyAnimation
    Set oeff = osld.TimeLine.MainSequence.FindFirstAnimationFor(graphicShp)
    oeff.Timing.TriggerDelayTime = (j - 4) * 4.5
    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
    graphicShp.Name = "graphic" & j + 1
    And another animation I used on rectangle shape
    Set rshp = osld.Shapes("rectangle5")
    rshp.PickupAnimation
    rshp.PickUp
    ' Capture properties of exisitng rectangle5 such as location and size
    With rshp
        t = .Top
        l = .Left
        h = .Height
        w = .Width
    End With
    Set rectShp = osld.Shapes.AddShape(rshp.AutoShapeType, l, t, w, h)
    If hshp.HasTextFrame Then
        rectShp.TextFrame.TextRange =rshp.TextFrame.TextRange
    End If
    rectShp.Apply
    rectShp.ApplyAnimation
    For P = 1 To osld.TimeLine.MainSequence.Count
        If osld.TimeLine.MainSequence(P).Shape.Id = rectShp.Id Then
            X = X + 1
            Set oeff = osld.TimeLine.MainSequence(P)
            Select Case X
                Case Is = 1
                    oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
                    oeff.Timing.TriggerDelayTime = (j - 4) * 4.5 + 1.9
                Case Is = 2
                   oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
                   oeff.Timing.TriggerDelayTime = (j - 4) * 4.5 + 1.9
                Case Is = 3
                   oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
                   oeff.Timing.TriggerDelayTime = (j - 4) * 4.5 + 5
                Case Is = 4
                   oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
                   oeff.Timing.TriggerDelayTime = (j - 4) * 4.5 + 2.2
             End Select
             oeff.Timing.TriggerType = msoAnimTriggerWithPrevious
            rectShp.Name = "rectangle" & j + 1
        End If
    Next P
     X = 0
    Next j
    I lost graphic shape animation completely.
    & for rectangle shape only first animation(ie entrance appaer type animation) works(out of 4).
    I do not want to change above code which is working fine so want to change replace audio code only.
    Last edited by Aussiebear; 05-16-2025 at 12:55 PM. Reason: Added CODE tags again

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •