Populate A PowerPoint Quiz From Excel With VBA

Excel PowerPoint Multiple Choice Quiz Automation VBA Code

A couple months ago I received an email from Titus who was looking for a way to easily populate and update a PowerPoint quiz from Excel. This article will outline my suggested solution which does the following:

  1. Allows the user to store the Slide Number, Question, 4 Choices, and the correct Answer within an Excel table
  2. User can execute a VBA macro to populate slides based off a pre-created PowerPoint slide template
  3. The VBA macro will add a Change Color animation to highlight the correct answer during the presentation

To demo how to automate this process, I have gone ahead and created a quiz slide that looks like the below screenshot:

Excel PowerPoint Multiple Choice Quiz Automation VBA Code

The following sections in this article will outline what needs to be done in Excel, PowerPoint, and VBA to get this quiz-generating process up and running. Enjoy!

Download The Example Files

If you need a little head start or are not comfortable with VBA quite yet, I have put together a sample Excel and PowerPoint file to show you how this process can be automated with VBA.

As always, in order to download this or any example file from this website, you will need to be a subscriber of my free tips newsletter.  If you click the green button below you can easily sign up and you will be emailed the password to get into the subscribers-only area of this website.

 
       Already Subscribed? Click   HERE   to log-in to the "Example Files" section

      Already Subscribed? Click HERE to log-in to the "Example Files" section

 

Excel Setup

The Microsoft Excel interface I set up is very simple. The data is stored in an Excel Table Object named QuizTable. This table is where you can store the following:

  • Slide #: Which slide the corresponding row's question/choices need to be sent to
  • Question:  Your slide question
  • Choice A - D: The four choices your audience can choose from
  • Answer: Designate the correct answer (Data Validation used to restrict inputs to A, B, C, or D)

There is also a named cell called SlideTemplate (currently located in cell B2) where you can designate a slide that the VBA code will copy in the event there are more questions in the Excel table than the count of slides currently in your PowerPoint presentation.

Another named cell called SlideCount, is just a helper cell to simplify the VBA code and determine how many slides need to be in the presentation.

Finally, there is a great-looking button over to the right called Create Quiz! This is what you'll click to generate/update your PowerPoint presentation. Please note that the VBA is setup to target the Active PowerPoint presentation, so make sure you have the proper presentation currently activated before running.

PowerPoint Setup

In my demo file, I have two slides generated:  (1) a title slide and (2) a quiz template slide.

With the quiz template slide there was a little bit of setup needed before it was ready to interact with VBA. Once I had my desired layout created, I went ahead and named each of my shapes a specific name through the Selection Pane (Home Tab > Editing Group > Select > Selection Pane). As you can see below, each shape has a logical name that will be referenced in the VBA code we'll be going over later on. Having standardized names will allow us to map our data in the Excel table to a specific shape in our PowerPoint slide.

How The Quiz Will Function In PowerPoint?

The end result of this automated process will allow you to create or update the slides designated within the Excel table and also add a Change Color animation that reveals the correct answer to the quiz question during the presentation. The below screenshots demonstrate the below/after views in PowerPoint's Presentation Mode.

Let's Get Into The VBA

Alright, now we get into the fun stuff! I will go ahead and layout the full VBA code and then delve into some of the important sections of the code to provide you with some commentary and reasoning for why I wrote what I wrote.

PLEASE NOTE in order to keep the code moderate in length, I did not add error handling for every situation that could go wrong with this proposed setup. For example, if you decide to delete one of the Excel table columns, that is going to cause an issue in the VBA code. So keep in mind if you're wanting to make your process bullet-proof, you are going to want to add some more error handlers to the following code.

Sub CreateQuiz()
'PURPOSE: Create a Multiple Choice Quiz from an Excel Table To PowerPoint
'SOURCE: www.TheSpreadsheetGuru.com

Dim pwr_App As Object
Dim ppt As Object
Dim ppt_shp As Object
Dim ppt_eff As Object
Dim SlideTemplate As Long
Dim SlideCount As Long
Dim QuizTable As ListObject
Dim Choice_A As String, Choice_B As String
Dim Choice_C As String, Choice_D As String
Dim rw As Range

'INPUTS
  Set QuizTable = ActiveSheet.ListObjects("QuizTable")
  SlideCount = ActiveSheet.Range("SlideCount").Value
  SlideTemplate = ActiveSheet.Range("SlideTemplate").Value

'Set variable equal to active presentation
  On Error GoTo NoPresentationFound
    Set pwr_App = GetObject(class:="PowerPoint.Application")
    Set ppt = pwr_App.ActivePresentation
  On Error GoTo 0
  
'Add Slides to presentation (If needed)
  For x = 1 To SlideCount - ppt.Slides.Count
    ppt.Slides(SlideTemplate).Copy
    DoEvents 'Make sure copy completes before moving on
    ppt.Slides.Paste
    DoEvents 'Make sure paste completes before moving on
  Next x

'Loop through each row in Quiz Tabl
  For Each rw In QuizTable.DataBodyRange.Columns(1).Cells
  
    'Store Row Inputs
      SlideNumber = rw.Value
      Question = rw.Offset(0, 1).Value
      Choice_A = "A. " & rw.Offset(0, 2).Value
      Choice_B = "B. " & rw.Offset(0, 3).Value
      Choice_C = "C. " & rw.Offset(0, 4).Value
      Choice_D = "D. " & rw.Offset(0, 5).Value
      Answer = rw.Offset(0, 6).Value
  
    'Transfer Inputs into PowerPoint Slide
      With ppt.Slides(SlideNumber)
      
        'Change Text on the Slide
          .Shapes("Question").TextFrame.TextRange.Text = Question
          .Shapes("Choice_A").TextFrame.TextRange.Text = Choice_A
          .Shapes("Choice_B").TextFrame.TextRange.Text = Choice_B
          .Shapes("Choice_C").TextFrame.TextRange.Text = Choice_C
          .Shapes("Choice_D").TextFrame.TextRange.Text = Choice_D
      
        'Ensure Any Old Choice Shape Animations are removed
          .Shapes("Choice_A").AnimationSettings.Animate = msoFalse
          .Shapes("Choice_B").AnimationSettings.Animate = msoFalse
          .Shapes("Choice_C").AnimationSettings.Animate = msoFalse
          .Shapes("Choice_D").AnimationSettings.Animate = msoFalse
      
        'Store Slide's "Correct Answer" Shape to a variable
          Set ppt_shp = .Shapes("Choice_" & Answer)
          
        'Add ChangeFillColor Animation to "Correct Answer" Shape (use enumeration value!)
          Set ppt_eff = .TimeLine.MainSequence.AddEffect( _
            Shape:=ppt_shp, effectid:=54) '54 = msoAnimEffectChangeFillColor
            
        'Set Color to Change "Correct Answer" shape to
          ppt_eff.EffectParameters.Color2.RGB = RGB(112, 173, 71)
        
        'Set color fade-in time
          ppt_eff.Timing.Duration = 0.4
          
      End With
  
  Next rw

'Completion Notification
  MsgBox "Your Quiz has successfully been updated!"

Exit Sub

'ERROR HANDLERS
NoPresentationFound:
  MsgBox "Could not find a PowerPoint presentation that was open", _
    16, "No Active Presentation"
  Exit Sub
  
End Sub

Determine Your Target PowerPoint file

Since we are running all the VBA code from Excel, we are going to need to reach out and determine which PowerPoint file we want to manipulate. The following snippet of VBA code creates a variable that points to the PowerPoint application itself (ie pwr_App) and then creates a variable that points to the Active PowerPoint presentation (ie ppt).

If an error is thrown, either your user does not have PowerPoint installed on the computer or your user doesn't currently have the PowerPoint application open.

These variables are extremely important as they will allow us to control both Excel and PowerPoint at the same time!

'Set variable equal to active presentation
  On Error GoTo NoPresentationFound
    Set pwr_App = GetObject(class:="PowerPoint.Application")
    Set ppt = pwr_App.ActivePresentation
  On Error GoTo 0

Do You Need To Add More Slides?

If you add more questions to your Excel table, you don't want to go through the hassle of going into PowerPoint and creating more slides before running your code. This section of code cross-references the amount of slides currently in your PowerPoint presentation with the highest slide number referenced in your Excel table. The loop will go through and copy/paste your designated template slide (slide number input into cell B2 of your Excel file) until enough slides have been added.

You may be wondering why I didn't account for the reverse effect....deleting slides if there are too many. I decided not to include this in the event you have other slides included in your presentation that are not part of your quiz.  For example, maybe you are running a department meeting and various people are speaking on different topics and you are starting the meeting off with a few quiz questions. You definitely wouldn't want your VBA code to go in and delete all the slides after your quiz!

'Add Slides to presentation (If needed)
  For x = 1 To SlideCount - ppt.Slides.Count
    ppt.Slides(SlideTemplate).Copy
    DoEvents 'Make sure copy completes before moving on
    ppt.Slides.Paste
    DoEvents 'Make sure paste completes before moving on
  Next x

Navigating The Excel Table and Sending Text To PowerPoint

In the below snippet, the VBA code will cycle through each row of the Excel table and store all the values within the table row to variables. Once we have this information stored, the VBA code easily sends it to the specific shape names in PowerPoint that were designated towards the beginning of this article.

There is also a section that removes any animation that may have been left over from a prior execution of this code. That way our slides are starting off fresh and there is no risk of having two correct answers animated during your presentation.

'Loop through each row in Quiz Tabl
  For Each rw In QuizTable.DataBodyRange.Columns(1).Cells
  
    'Store Row Inputs
      SlideNumber = rw.Value
      Question = rw.Offset(0, 1).Value
      Choice_A = "A. " & rw.Offset(0, 2).Value
      Choice_B = "B. " & rw.Offset(0, 3).Value
      Choice_C = "C. " & rw.Offset(0, 4).Value
      Choice_D = "D. " & rw.Offset(0, 5).Value
      Answer = rw.Offset(0, 6).Value
  
    'Transfer Inputs into PowerPoint Slide
      With ppt.Slides(SlideNumber)
      
        'Change Text on the Slide
          .Shapes("Question").TextFrame.TextRange.Text = Question
          .Shapes("Choice_A").TextFrame.TextRange.Text = Choice_A
          .Shapes("Choice_B").TextFrame.TextRange.Text = Choice_B
          .Shapes("Choice_C").TextFrame.TextRange.Text = Choice_C
          .Shapes("Choice_D").TextFrame.TextRange.Text = Choice_D
      
        'Ensure Any Old Choice Shape Animations are removed
          .Shapes("Choice_A").AnimationSettings.Animate = msoFalse
          .Shapes("Choice_B").AnimationSettings.Animate = msoFalse
          .Shapes("Choice_C").AnimationSettings.Animate = msoFalse
          .Shapes("Choice_D").AnimationSettings.Animate = msoFalse
      End With
  
  Next rw

Applying the Correct Answer Animation

Finally, we are going to single out the answer to the question and apply an animation that will change the correct choice's color to green.

First, the code will point a variable to the shape housing the answer by reading the answer from the Excel table and placing the phrase "Choice_" in front of it. This combination will match one of our PowerPoint shape names.

Next, the VBA code will add a specific animation to the shape (in this case I chose the ChangeFillColor effect). It is important to use the enumeration (numeric) value instead of the textual name for the effect since our VBA is in Excel and not PowerPoint. For a list of all the possible animations you can add, check out Microsoft's list of msoAnimEffect names.

Finally, I threw in some code to determine the animation color (in my example green) using the RGB color code. I also tweaked the length of the color fading between the current color and my animation color to 0.4 seconds (I didn't like the default transition length).

With ppt.Slides(SlideNumber)

  'Store Slide's "Correct Answer" Shape to a variable
    Set ppt_shp = .Shapes("Choice_" & Answer)
    
  'Add ChangeFillColor Animation to "Correct Answer" Shape (use enumeration value!)
    Set ppt_eff = .TimeLine.MainSequence.AddEffect( _
      Shape:=ppt_shp, effectid:=54) '54 = msoAnimEffectChangeFillColor
      
  'Set Color to Change "Correct Answer" shape to
    ppt_eff.EffectParameters.Color2.RGB = RGB(112, 173, 71)
  
  'Set color fade-in time
    ppt_eff.Timing.Duration = 0.4
    
End With

You're All Set!

That covers all the basic steps to get the process of creating/updating PowerPoint slides for your mulitple-choice quiz. I hope you were able to follow along and understand all the necessary steps of the process. Be sure to download the example files I used in this article to save yourself some time and effort (see the big green button towards the beginning of the article).

How Do I Modify This To Fit My Specific Needs?

Chances are this post did not give you the exact answer you were looking for. We all have different situations and it's impossible to account for every particular need one might have. That's why I want to share with you: My Guide to Getting the Solution to your Problems FAST! In this article, I explain the best strategies I have come up with over the years to getting quick answers to complex problems in Excel, PowerPoint, VBA, you name it

I highly recommend that you check this guide out before asking me or anyone else in the comments section to solve your specific problem. I can guarantee 9 times out of 10, one of my strategies will get you the answer(s) you are needing faster than it will take me to get back to you with a possible solution. I try my best to help everyone out, but sometimes I don't have time to fit everyone's questions in (there never seem to be quite enough hours in the day!).

I wish you the best of luck and I hope this tutorial gets you heading in the right direction!

Chris :)