How to create Interactive Fill in the Blanks Game in PowerPoint using VBA
✅ Add Timer and Calculate the number of correct and wrong answers!
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
Now, go to Slide Show | From Beginning and play the Fill In The Blanks Game in Microsoft PowerPoint!
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