How to create Interactive Fill in the Blanks Game in PowerPoint using VBA
✅ Add Timer and Calculate the number of correct and wrong answers!
How to Make a Countdown Timer in PowerPoint without Animations
The PowerPoint Fill in the Blanks Quiz Game allows the student to type the answer within a textbox in Slide Show Mode. They can also verify their answer and see a report that contains the number of questions that they got right and wrong.
Teachers can create an infinite number of question slides and add multiple blanks in each slide. An innovative method of declaring the correct answer of each blank is by typing it outside the same slide. We then tell our VBA Code to match both the answers (the one attempted by the student and the text present outside the slide) and evaluate the answer. This allows the teachers to quickly modify the template and edit the correct answer without having to change any of the VBA Macro Codes.
Since we shall be using VBA and ActiveX Elements in PowerPoint, this game would work only in Windows.
Softwares:
Features:
Here is how we create an Interactive PowerPoint Quiz Game:
Step 1: Add Title Slide
Step 2: Add Question Slide
Step 3: Enable Developer Tab
Step 5: Add TextBox
Under the Developer Tab, select the TextBox ActiveX Element and insert it on top of the blank. Select the TextBox, click on Properties, change its name to AA and make the caption blank.
Step 6: Insert Correct Answer
CA. Type the correct answer within it.Step 7: Paste VBA Code
We shall be using the following VBA Code to evaluate the answer inputted by the student with the correct answer typed in the textbox that was placed outside the slide.
The ActiveX TextBox is a versatile tool to collect input data from students. We can use .Value to read the text present within it. Hence, we use an If-Then-Else condition to crosscheck the Input Answer with the Correct Answer.
We shall also be converting both the pieces of text into uppercase using the UCase function as Harry potter is not the same as Harry Potter or harry POTTER in the eyes of the computer.
Sub Initialise()
For i = 2 To 6 'change the numbers accordingly
ActivePresentation.Slides(i).Shapes("AA").OLEFormat.Object.Value = ""
Next i
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub CheckAnswer()
Dim CS As Slide
Set CS = ActivePresentation.SlideShowWindow.View.Slide 'represents the current slide presented, not the slide number
If UCase(CS.Shapes("AA").OLEFormat.Object.Value) = UCase(CS.Shapes("CA").TextFrame.TextRange) Then
MsgBox "Correct Answer"
ActivePresentation.SlideShowWindow.View.Next
Else
MsgBox "Wrong Answer. Try Again!"
End If
End Sub
We would also need to run the VBA Macros when the respective shapes are clicked. To do this, select the shape, go to Insert | Actions | Run Macro
The “StartGame” Shape in Slide 1 shall run Initialise and the “Next” Shapes in all the question slides shall run CheckAnswer.
Now, go to Slide Show | From Beginning and play the Fill In The Blanks Game in Microsoft PowerPoint!
Scoring System
We shall now be creating a Report Card Slide in the Fill In The Blanks PowerPoint Game that would show the number of correct, wrong and unattempted questions.
We can embed a scoring system in PowerPoint Games using ActiveX Labels which would increase its caption. In this game, the student has the option of attempting the question incorrectly multiple times. Hence, we should count only the first attempt. To do this, we shall be using Boolean (data class with values True or False) that will allow us to know if the question was attempted previously. We need to declare that in the beginning of the module since we will be using that variable inside multiple sub-routines.
Dim QuestionAttempted As Boolean
Sub Initialise()
QuestionAttempted = False
SlideLayout31.CA.Caption = 0
SlideLayout31.WA.Caption = 0
For i = 2 To 6
ActivePresentation.Slides(i).Shapes("AA").OLEFormat.Object.Value = ""
Next i
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub CheckAnswer()
Dim CS As Slide
Set CS = ActivePresentation.SlideShowWindow.View.Slide
'To find whether AA = CA
If UCase(CS.Shapes("AA").OLEFormat.Object.Value) = UCase(CS.Shapes("CA").TextFrame.TextRange) Then
MsgBox "Correct Answer"
If QuestionAttempted = False Then
SlideLayout31.CA.Caption = (SlideLayout31.CA.Caption) + 1
End If
ActivePresentation.SlideShowWindow.View.GotoSlide (CurrentSlideNo + 1)
QuestionAttempted = False
CalculateUnattemptedAnswer
Else
MsgBox "Wrong Answer. Try Again!"
If QuestionAttempted = False Then
SlideLayout31.WA.Caption = (SlideLayout31.WA.Caption) + 1
End If
QuestionAttempted = True
CalculateUnattemptedAnswer
End If
End Sub
Time Limit Per Question
How can we add a 10 second time limit for every question slide?
Select your question slides and go to the Transitions Tab. Select “Advance Slide”. Here, you can input the time-limit value in seconds. You can customise the time limit as per your needs.
To show the passage of time, we can insert a rectangle at the top and insert an exit wipe animation whose duration will also be for 10 seconds.
We have to make appropriate changes in our VBA Macro codes too. We now have another category to insert in the last result slide – Number of Unattempted Answers. We can make its provision by making another Label and using the following subroutine to calculate that:
Sub CalculateUnattemptedAnswer()
SlideLayout31.UA.Caption = (5) - (SlideLayout31.CA.Caption) - (SlideLayout31.WA.Caption)
End Sub
Multiple Blanks in Slide
Add multiple ActiveX TextBoxes to our PowerPoint Slide thus, having multiple blanks in our Fill in the Blanks Game in PowerPoint. This seems simple enough, we now just have to cross check each and every attempted answer with the correct answer shape which is placed outside the slide.
Rename “AA” as “AA1” via selection pane and do the same with CA, i.e “CA” becomes “CA1”. Now, we just have to duplicate our code which will equate both the values one-by-one.
Instead of duplicating the code, we can use a For Loop which will generate number from 1 To 4 in this case. So, AA1 = CA1 to AA4 = CA4 is checked.
Also, changing the shape name from “CA” to “CA1” in multiple slides can be very tedious. Thus, we can use a simple VBA Macro Code in Microsoft PowerPoint which will allow us to rename the Shape’s name:
During our loop, we increase the value of the “CorrectBlanks” integer by +1 every time “AA” & i is equal To “CA” & i.
We also set the value of NoOfBlanks to be equal to i.
Thus, the above integer keeps getting updated until an error pops up saying that the Shape “AA” & i doesn’t exist.
At the point of time, we go to CheckIfAllCorrect: in our VBA Macro and then add an If-Condition.
If the number of blanks is equal to the number of CorrectBlanks, we can successfully move on to the next question.
And once that happens, we can reset the value of CorrectBlanks to 0.
Sub Initialise()
For i = 2 To 7
For a = 1 To 20 'maximum number of blanks
On Error Resume Next
ActivePresentation.Slides(i).Shapes("AA" & a).OLEFormat.Object.Value = ""
Next a
Next i
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub CheckAnswer()
Dim CS As Slide "CS Stands for Current Slide"
Set CS = ActivePresentation.SlideShowWindow.View.Slide
CorrectBlanks = 0
For i = 1 To 10
On Error GoTo CheckIfAllCorrect
If UCase(CS.Shapes("AA" & i).OLEFormat.Object.Value) = UCase(CS.Shapes("CA" & i).TextFrame.TextRange) Then
MsgBox "Correct Answer", vbInformation, "Answer " & i
CorrectBlanks = CorrectBlanks + 1
Else
MsgBox "Wrong Answer. Try Again!", vbCritical, "Answer " & i
End If
NoOfBlanks = i
Next i
CheckIfAllCorrect:
If CorrectBlanks = NoOfBlanks Then
ActivePresentation.SlideShowWindow.View.Next
End If
End Sub