Insert Sound file in PPT Macro/VBA

[Little Maste]

Dear Friends,

I seek help to insert sound file in ppt through macro. Attahced PPT is to be used for performing a quiz and it contains macro if correct answer is selected it prompts "Correct" and if incorrect answer is selected it prompts "Wrong answer"

Now, I need help to insert different sounds for correct & incorrect answers.

Any kind of help is highly appreciated.

I am not able to attach the file due to size restrictions. Hence below is the code i am using


Sub Correct()
Points.Caption = (Points.Caption) + 10
Output = MsgBox("Your Answer is correct, well done!", vbOKOnly, "Correct Answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Wrong()
Points.Caption = (Points.Caption) - 0
Output = MsgBox("Your Answer is wrong.", vbOKOnly, "Incorrect Answer")

End Sub
Sub Reset()
Points.Caption = 0
ActivePresentation.SlideShowWindow.View.Exit
End Sub
Sub Retry()
Points.Caption = 0
ActivePresentation.SlideShowWindow.View.GotoSlide (1)
End Sub

[venablest]

I hope the following code helps you. There are 2 Subs here, one to insert and play the sound on the slide and the other to remove/stop sounds.
The reason I have added "remove_sound" is because if you don't remove the inserted sound then the next time you run the PowerPoint they will play again as soon as you come back to that slide.




' Code to remove sound from slide. This will aslo stop the sound if it is playing
Sub remove_sound(shapename As String)


Dim current_slide As Slide
Dim the_shape As Shape


' Get current slide
Set current_slide = ActivePresentation.SlideShowWindow.View.Slide


' Loop thorough each shape in slide
For Each the_shape In current_slide.Shapes
' Check for sound shapes
If the_shape.Type = msoMedia Then
If the_shape.MediaType = ppMediaTypeSound Then
' Delete the sound shape
If shapename = the_shape.Name Then
the_shape.Delete
End If
End If
End If
Next


End Sub




' Code to play a sound
Function play_sound(filepath As String) As String


Dim oShp As Object
Dim oEffect As Effect
Dim current_slide As Slide


' Get current slide
Set current_slide = ActivePresentation.SlideShowWindow.View.Slide


' Add the audio shape
Set oShp = current_slide.Shapes.AddMediaObject2(filepath, True, False, 0, 0)


' Set audio to play automatically
Set oEffect = current_slide.TimeLine.MainSequence.AddEffect(oShp, msoAnimEffectMediaPlay, , msoAnimTriggerWithPrevious)
oEffect.MoveTo 1

' Hide effect icon in slideshow
oEffect.EffectInformation.PlaySettings.HideWhileNotPlaying = True

' Start playing now
oEffect.Timing.TriggerDelayTime = 0

' Return the sound name
play_sound = oShp.Name


End Function



I would call them from your code like this, change "C:\soundfolder\correctsound.mp3" to whatever the location of your sound file is...




Sub Correct()
Dim sound_name As String


Points.Caption = (Points.Caption) + 10


sound_name = play_sound("C:\soundfolder\correctsound.mp3")


Output = MsgBox("Your Answer is correct, well done!", vbOKOnly, "Correct Answer")


Call remove_sound(sound_name)


ActivePresentation.SlideShowWindow.View.Next
End Sub



...and do the same sort of thing with the wrong answer.