PDA

View Full Version : Replace audio file in powerpoint



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

John Wilson
09-16-2020, 08:41 AM
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.

papuapu
09-17-2020, 07:46 AM
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.