• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1643
  • Last Modified:

PowerPoint VBA - Insert Audio Clips to each slide

I need to automate this. I have a series of short audio clips in a folder. Each approx 20 secs. I want to Insert > Audio > From File on each slide sequentially. It can be on a New PowerPoint presentation.
And set the audio clip to:
Start With Previous
Stop After 1 Slide.

My Excel VBA is at a high level but is NIL on PowerPoint.

Thanks experts!
0
hindersaliva
Asked:
hindersaliva
1 Solution
 
JSRWilsonCommented:
This should get you close. Obviously change the folder path and the filespec if they are not mp3 files. Some of the code is adapted from Steve Rindsberg's PPTFAQ

Sub Audio_In()
    Dim rayFileList() As String
    Dim FolderPath As String
    Dim FileSpec
    Dim strTemp As String
    Dim x As Long
    Dim opres As Presentation
    Set opres = Presentations.Add(WithWindow:=True)
    ' EDIT THESE to suit your situation
    FolderPath = "c:\Users\John\Desktop\Music\"  ' Note: MUST end in \
    FileSpec = "*.mp3"
    ' END OF EDITS
    
    ReDim rayFileList(1 To 1) As String
    strTemp = Dir$(FolderPath & FileSpec)
    While strTemp <> ""
        rayFileList(UBound(rayFileList)) = FolderPath & strTemp
        ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As String
        strTemp = Dir
    Wend

    If UBound(rayFileList) > 1 Then
        For x = 1 To UBound(rayFileList) - 1
            Call InsertMe(rayFileList(x), opres)
        Next x
    End If

End Sub

Sub InsertMe(filePath As String, opres As Presentation)
Dim omusic As Shape
Dim osld As Slide
Dim oeff As Effect
On Error Resume Next
Set osld = opres.Slides.Add(opres.Slides.Count + 1, ppLayoutTitleOnly)
Set omusic = osld.Shapes.AddMediaObject2(filePath, Left:=10, Top:=10, Width:=20, Height:=20)
With omusic
osld.TimeLine.InteractiveSequences(1).Item(1).Delete
Set oeff = osld.TimeLine.MainSequence.AddEffect(omusic, msoAnimEffectMediaPlay, , msoAnimTriggerWithPrevious)
oeff.EffectInformation.PlaySettings.StopAfterSlides = 1
End With
End Sub

Open in new window

0
 
hindersalivaAuthor Commented:
I haven't tested it yet. But I know JSRW's solutions are good.
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now