3.PowerPoint VBA Create Interactive QUIZ Template

In this Blog post, we are going to create this beautiful QUIZ template using PowerPoint. We are going to make it highly interactive using PowerPoint VBA and we will also implement a scoring system for each question. Let’s start from scratch and carefully examine each step of the process.

Lets start by design below shown template by drawing few rounded rectangle shapes, remove their fill colors, change their outline colors and apply matching Glow Effect of 8 points. Also necessary text and the Quiz template design should like below.

Next important step is to rename all these shapes to that we can easily reference them in our VBA script, so lets go to ‘selection pane’ and rename Score shape as ‘Score’. Rename ‘Answer 1’ shape as ‘option 1’, ‘Answer 2’ shape as ‘option 2’, ‘Answer 3’ shape as ‘option 3’, and ‘Answer 4’ shape as ‘option 4’. Below image shows the alternate names of each shape under “Selection Pane”

Once all shapes are renamed, go to developer tab and then open the VB Editor.

In the VB editor, right click inside the VB project window, and insert a new module.

Once done, copy below ‘Wrong Answer’ subroutine, and paste it into this module.

Sub onClick_WrongAnswer(assigned_Shape As Shape)

    Dim active_Slide As Slide
    Dim current_Score As Integer
    Dim sld As Slide
    
    Set active_Slide = ActivePresentation.SlideShowWindow.View.Slide
    current_Score = CInt(active_Slide.Shapes("Score").TextFrame.TextRange.Text)
    
             
     If active_Slide.Tags("Answered") = "True" Then
            MsgBox "This Question is already Answered.! Please Proceed to next Question.!", vbCritical, "Double Hit"
            Exit Sub
     End If
             
    active_Slide.Shapes(assigned_Shape.Name).Line.ForeColor.RGB = RGB(255, 255, 255)
    active_Slide.Shapes(assigned_Shape.Name).Glow.Color.RGB = RGB(255, 0, 0)
    active_Slide.Shapes(assigned_Shape.Name).Fill.ForeColor.RGB = RGB(255, 0, 0)
    active_Slide.Shapes(assigned_Shape.Name).TextFrame.TextRange.Text = "WRONG ANSWER"
    
    active_Slide.Shapes("Score").TextFrame.TextRange.Text = CStr(current_Score - 5)
    
    active_Slide.Tags.Add "Answered", "True"
    
    For Each sld In ActivePresentation.Slides
            sld.Shapes("Score").TextFrame.TextRange.Text = CStr(current_Score - 5)
    Next sld
    
    
End Sub

Now copy below ‘Correct Answer’ subroutine, and paste it below the wrong answer subroutine, into the same module.

Sub onClick_CorrectAnswer(assigned_Shape As Shape)
Dim active_Slide As Slide
Dim current_Score As Integer
Dim sld As Slide

Set active_Slide = ActivePresentation.SlideShowWindow.View.Slide
current_Score = CInt(active_Slide.Shapes("Score").TextFrame.TextRange.Text)


 If active_Slide.Tags("Answered") = "True" Then
        MsgBox "This Question is already Answered.! Please Proceed to next Question.!", vbCritical
        Exit Sub
 End If

active_Slide.Shapes(assigned_Shape.Name).Line.ForeColor.RGB = RGB(255, 255, 255)
active_Slide.Shapes(assigned_Shape.Name).Glow.Color.RGB = RGB(0, 255, 0)
active_Slide.Shapes(assigned_Shape.Name).Fill.ForeColor.RGB = RGB(0, 255, 0)
active_Slide.Shapes(assigned_Shape.Name).TextFrame.TextRange.Text = "CORRECT ANSWER"

active_Slide.Shapes("Score").TextFrame.TextRange.Text = CStr(current_Score + 10)

active_Slide.Tags.Add "Answered", "True"

For Each sld In ActivePresentation.Slides
        sld.Shapes("Score").TextFrame.TextRange.Text = CStr(current_Score + 10)
Next sld

End Sub

Please note : Using above 2 Subroutines, we are subtracting 5 points for every wrong answer, and adding 10 points for every correct answer.

Next step is to assign these 2 Subroutines to each of option shapes (ANSWER 1 to ANSWER 4) as per your requirement. Say you want to assign “Wrong Answer” subroutine to ‘ANSWER 1’ shape, just select this shape, go to ‘Insert‘ tab, and click on ‘Actions‘. Now on ‘Action Setting‘ window, select run macro and choose ‘onClick_WrongAnswer‘ subroutine.

Following the same steps, assign ‘Wrong Answer’ and ‘Correct Answer’ subroutines to other 3 shapes, but make sure only one shape is assigned with ‘Correct Answer’ (obviously!). Off course, you need to change the Question text as well. You can duplicate this slide, change the question and change their 4 options. Also make sure to assign the ‘Wrong Answer’ and ‘Correct Answer’ subroutines in different patterns.

Once done, put this presentation in slideshow mode and click on any one of the 4 options to see the magic.

You can see the detailed Tutorial in below video.