Results 1 to 2 of 2

Thread: Insert Sound file in PPT Macro/VBA

  1. #1

    Insert Sound file in PPT Macro/VBA

    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")
    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
    End Sub
    Sub Retry()
    Points.Caption = 0
    ActivePresentation.SlideShowWindow.View.GotoSlide (1)
    End Sub

  2. #2
    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
                    End If
                End If
            End If
    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)
    End Sub

    ...and do the same sort of thing with the wrong answer.
    Please see my Udemy course "PowerPoint VBA Macros and Coding Interactive Presentations"
    Send me a private message for a course coupon

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts