papuapu
09-15-2020, 12:21 PM
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
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