Consulting

Results 1 to 3 of 3

Thread: Replace audio file in powerpoint

  1. #1
    Banned VBAX Regular
    Joined
    Sep 2020
    Location
    https://t.me/pump_upp
    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 Paul_Hossler; 09-15-2020 at 03:53 PM. Reason: Added CODE tags

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    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
    Location
    https://t.me/pump_upp
    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 Paul_Hossler; 09-25-2020 at 10:02 AM. 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
  •