Search code examples
vbapowerpointmedia

Change Media Object (VBA PowerPoint)


I just want to change the music of a Media Object in PowerPoint using Macros. I have a music in a Slide, but I can't figure out how I can change it to different music. Or is it possible to replace it by a new one but with the same properties...? I tried playing around with following code but I don't know the rest...

Slide3.Shapes("bg_music").MediaFormat. 'code that I don't know to change it's music/media

Solution

  • You're going to need to delete the existing shape and replace it with a new one, copying the properties as needed. This MSDN article enumerates some (all?) of the MediaFormat properties.

    Option Explicit
    
    Sub ReplaceMediaFormat()
    Dim sld As Slide
    Dim newShp As Shape
    Dim shp As Shape
    Dim mf As MediaFormat
    Dim path As String
    
    Set sld = ActivePresentation.Slides(1) '// Modify as needed
    Set shp = sld.Shapes("bg_music")
    Set mf = shp.MediaFormat
    
    '// Modify the path for your new media file:
    path = "C:\Users\david.zemens\Downloads\2540.mp3"
    
    Set newShp = sld.Shapes.AddMediaObject2(path)
    With newShp
        .Top = shp.Top
        .Left = shp.Left
        .Width = shp.Width
        .Height = shp.Height
        ' etc...
    
    End With
    
    ' // copy the mediaformat properties as needed
    
    With newShp.MediaFormat
        .StartPoint = mf.StartPoint
        .EndPoint = mf.EndPoint
        .FadeInDuration = mf.FadeInDuration
        .FadeOutDuration = mf.FadeOutDuration
        .Muted = mf.Muted
        .Volume = mf.Volume
        ' etc...
    End With
    
    '// remove the original
    shp.Delete
    
    Dim eff As Effect
    '// Creates an effect in the timeline which triggers this audio to play when the slideshow begins
    Set eff = sld.TimeLine.MainSequence.AddEffect(newShp, msoAnimEffectMediaPlay, trigger:=msoAnimTriggerWithPrevious)
    
    With newShp.AnimationSettings.PlaySettings
        .LoopUntilStopped = msoCTrue
        .PauseAnimation = msoFalse
        .PlayOnEntry = msoCTrue
        .RewindMovie = msoCTrue
        .StopAfterSlides = 999
        .HideWhileNotPlaying = msoTrue
    End With
    

    With help from this article, I can get the audio to play automatically by creating an effect (see above Set eff = ...).