Consulting

Results 1 to 3 of 3

Thread: Replace audio file in powerpoint

  1. #1
    VBAX Newbie
    Joined
    Sep 2020
    Posts
    2
    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 Paul_Hossler; 09-15-2020 at 03:53 PM. Reason: Added CODE tags

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,934
    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
    VBAX Newbie
    Joined
    Sep 2020
    Posts
    2
    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.

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
  •