VOILA! One Click PowerPoint Quiz Maker (AKA: Yontaku PowerPoint Quiz Maker): Free Download

Description:
This started life a few days ago as a simple question and is now a finished proof of concept. What if you didn't need to rely on Excel to store data in PowerPoint? This application stores data in a table on a slide. Thus, eliminating the need to ever open an application within an application. In ONE CLICK, you can make you make your quiz. Because a table is essentially a shape, it can be made invisible. The user never sees where the data is being stored. It's a simple, elegant to a solution to a problem that nobody asked to solve, but my OCD and curiosity got the better of me.  Best of all... It's free. 

This latest version has several quality-of-life fixes, and it can make a PDF answer sheet for you!

Download Link:
Download Yontaku PowerPoint Quiz Maker

This is so cool!

It inspired me to have a go at making a template for the gameshow 'The Chase'. I don't think I can use this quiz maker unfortunately though because of the formatting differences - but it certainly gave me the idea!

Thanks johnr,

I'm glad you liked it. Please feel free to cannibalize any code you like. Unfortunately, I have a lot of life responsibilities at the moment, so I can't take this project any further than a simple proof of concept.

I will however take this opportunity to do some shameless self-promotion. My stick figure quiz fighter game has roughly 40,000 lines of vba code. Its features are way more fleshed-out than this such as a built-in file manager and the ability to make macro-free versions of itself.  It also comes with customer support. 

So, I lied! 

I had a bit of free time this morning at work, so I made a few quality-of-life improvements. It would be cool to see this project fully fleshed out, but it's really just a novelty. I was thinking about adding a randomization feature, but since the solution wasn't immediately obvious, I gave up. However, since it was trivial to add a timer, that feature is now fully functional, and you can choose a different color for each question. Use the slider to decide how many sections you want the timer animation to take. 

I changed the name of the application to Yontaku. Literally, (四) Four (択) choices in Japanese. 





See below for latest download link.

matto wrote:So, I lied! 

I had a bit of free time this morning at work, so I made a few quality-of-life improvements. It would be cool to see this project fully fleshed out, but it's really just a novelty. I was thinking about adding a randomization feature, but since the solution wasn't immediately obvious, I gave up. However, since it was trivial to add a timer, that feature is now fully functional, and you can choose a different color for each question. Use the slider to decide how many sections you want the timer animation to take. 

I changed the name of the application to Yontaku. Literally, (四) Four (択) choices in Japanese. 





Download: New Version

So there is an easy way to add randomization the easy way: a string!

Create a TextBox for each slide that holds it's "index", then generate a string of length: # of slides with digits of value: Rand(# Slides). Just ensure that you generate the string using a For() loop that checks every previously-generated digit to ensure there's no repeats, and you're done! Then all you have to do is set up triggers that send you to the slide desired. It's still somewhat complicated, but a LOT more doable than trying to truly randomize the slides.

I think you're assuming that I was referring to randomizing slides after the application creates a PowerPoint, and that's not what I'm referring to. The application goes through the table on the first slide and loops every column into a series of arrays. There are nine arrays in total. 

Code:

Dim QUESTION_NUMBER() As Integer
Dim FIELD_1_QUESTION() As String
Dim FIELD_2_ANSWER1() As String
Dim FIELD_3_ANSWER2() As String
Dim FIELD_4_ANSWER3() As String
Dim FIELD_5_ANSWER4() As String
Dim FIELD_6_CORRECT_ANSWER() As Integer
Dim FIELD_7_TIMER() As Integer
Dim FIELD_8_TIMER_COLOR() As Integer

The issue is that these aren't finite arrays. You can see that they don't specify a finite number of items. The arrays are expanded and updated when the user changes information, adds new items, or moves items around in the listbox. It's just a little more challenging to shuffle the index of an array when you don't know its upper bound. 

I'm too mentally deflated right now to write the code...

Got it

Code:

Dim RND_NIM() As Integer
ReDim RND_NUM(1 To UBound(QUESTION_NUMBER))
Dim rndindex As Integer
Dim temp As Integer

For i = 1 To UBound(QUESTION_NUMBER): RND_NUM(i) = i: Next i
For i = 1 To UBound(QUESTION_NUMBER)
rndindex = Int(UBound(QUESTION_NUMBER) * Rnd()) + 1
temp = RND_NUM(rndindex)
RND_NUM(rndindex) = RND_NUM(i)
RND_NUM(i) = temp
Next i

Dim QUESTION_NUMBER_TEMP() As Integer
ReDim QUESTION_NUMBER_TEMP(1 To UBound(QUESTION_NUMBER))
For i = 1 To UBound(QUESTION_NUMBER)
QUESTION_NUMBER_TEMP(i) = QUESTION_NUMBER(i)
Next i

For i = 1 To UBound(QUESTION_NUMBER)
QUESTION_NUMBER(RND_NUM(i)) = QUESTION_NUMBER_TEMP(i)
Next i

Dim FIELD_1_QUESTION_TEMP() As String
ReDim FIELD_1_QUESTION_TEMP(1 To UBound(FIELD_1_QUESTION))
For i = 1 To UBound(FIELD_1_QUESTION)
FIELD_1_QUESTION_TEMP(i) = FIELD_1_QUESTION(i)
Next i

For i = 1 To UBound(FIELD_1_QUESTION)
FIELD_1_QUESTION(RND_NUM(i)) = FIELD_1_QUESTION_TEMP(i)
Next i

Dim FIELD_2_ANSWER1_TEMP() As String
ReDim FIELD_2_ANSWER1_TEMP(1 To UBound(FIELD_2_ANSWER1))
For i = 1 To UBound(FIELD_2_ANSWER1)
FIELD_2_ANSWER1_TEMP(i) = FIELD_2_ANSWER1(i)
Next i

For i = 1 To UBound(FIELD_2_ANSWER1)
FIELD_2_ANSWER1(RND_NUM(i)) = FIELD_2_ANSWER1_TEMP(i)
Next i

Dim FIELD_3_ANSWER2_TEMP() As String
ReDim FIELD_3_ANSWER2_TEMP(1 To UBound(FIELD_3_ANSWER2))
For i = 1 To UBound(FIELD_3_ANSWER2)
FIELD_3_ANSWER2_TEMP(i) = FIELD_3_ANSWER2(i)
Next i

For i = 1 To UBound(FIELD_3_ANSWER2)
FIELD_3_ANSWER2(RND_NUM(i)) = FIELD_3_ANSWER2_TEMP(i)
Next i

Dim FIELD_4_ANSWER3_TEMP() As String
ReDim FIELD_4_ANSWER3_TEMP(1 To UBound(FIELD_4_ANSWER3))
For i = 1 To UBound(FIELD_4_ANSWER3)
FIELD_4_ANSWER3_TEMP(i) = FIELD_4_ANSWER3(i)
Next i

For i = 1 To UBound(FIELD_4_ANSWER3)
FIELD_4_ANSWER3(RND_NUM(i)) = FIELD_4_ANSWER3_TEMP(i)
Next i

Dim FIELD_5_ANSWER4_TEMP() As String
ReDim FIELD_5_ANSWER4_TEMP(1 To UBound(FIELD_5_ANSWER4))
For i = 1 To UBound(FIELD_5_ANSWER4)
FIELD_5_ANSWER4_TEMP(i) = FIELD_5_ANSWER4(i)
Next i

For i = 1 To UBound(FIELD_5_ANSWER4)
FIELD_5_ANSWER4(RND_NUM(i)) = FIELD_5_ANSWER4_TEMP(i)
Next i

Dim FIELD_6_CORRECT_ANSWER_TEMP() As Integer
ReDim FIELD_6_CORRECT_ANSWER_TEMP(1 To UBound(FIELD_6_CORRECT_ANSWER))
For i = 1 To UBound(FIELD_6_CORRECT_ANSWER)
FIELD_6_CORRECT_ANSWER_TEMP(i) = FIELD_6_CORRECT_ANSWER(i)
Next i

For i = 1 To UBound(FIELD_6_CORRECT_ANSWER)
FIELD_6_CORRECT_ANSWER(RND_NUM(i)) = FIELD_6_CORRECT_ANSWER_TEMP(i)
Next i

Dim FIELD_7_TIMER_TEMP() As Integer
ReDim FIELD_7_TIMER_TEMP(1 To UBound(FIELD_7_TIMER))
For i = 1 To UBound(FIELD_7_TIMER)
FIELD_7_TIMER_TEMP(i) = FIELD_7_TIMER(i)
Next i

For i = 1 To UBound(FIELD_7_TIMER)
FIELD_7_TIMER(RND_NUM(i)) = FIELD_7_TIMER_TEMP(i)
Next i

Dim FIELD_8_TIMER_COLOR_TEMP() As Integer
ReDim FIELD_8_TIMER_COLOR_TEMP(1 To UBound(FIELD_8_TIMER_COLOR))
For i = 1 To UBound(FIELD_8_TIMER_COLOR)
FIELD_8_TIMER_COLOR_TEMP(i) = FIELD_8_TIMER_COLOR(i)
Next i

For i = 1 To UBound(FIELD_8_TIMER_COLOR)
FIELD_8_TIMER_COLOR(RND_NUM(i)) = FIELD_8_TIMER_COLOR_TEMP(i)
Next i


For i = 1 To UBound(QUESTION_NUMBER)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 1).Shape.TextFrame.TextRange.Text = FIELD_1_QUESTION(i)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 2).Shape.TextFrame.TextRange.Text = FIELD_2_ANSWER1(i)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 3).Shape.TextFrame.TextRange.Text = FIELD_3_ANSWER2(i)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 4).Shape.TextFrame.TextRange.Text = FIELD_4_ANSWER3(i)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 5).Shape.TextFrame.TextRange.Text = FIELD_5_ANSWER4(i)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 6).Shape.TextFrame.TextRange.Text = FIELD_6_CORRECT_ANSWER(i)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 7).Shape.TextFrame.TextRange.Text = FIELD_7_TIMER(i)
ActivePresentation.Slides(1).Shapes("Table 1").Table.Cell(i, 8).Shape.TextFrame.TextRange.Text = FIELD_8_TIMER_COLOR(i)
Next i

After 4 long days of working on 'The Chase' template, I have a version that seems to work.

I've posted it here: THE CHASER

Thanks again for the inspiration!

A small update: I made a message box to show the results of the randomization. If you click "yes", then it will randomize your questions according to the current pattern. If you click "no", then it will generate a new pattern. 

Code:

Start:

For i = 1 To UBound(QUESTION_NUMBER): RND_NUM(i) = i: Next i
For i = 1 To UBound(QUESTION_NUMBER)
rndindex = Int(UBound(QUESTION_NUMBER) * Rnd()) + 1
temp = RND_NUM(rndindex)
RND_NUM(rndindex) = RND_NUM(i)
RND_NUM(i) = temp
Next i

Dim QUESTION_NUMBER_TEMP() As Integer
ReDim QUESTION_NUMBER_TEMP(1 To UBound(QUESTION_NUMBER))
For i = 1 To UBound(QUESTION_NUMBER)
QUESTION_NUMBER_TEMP(i) = QUESTION_NUMBER(i)
Next i

MSG = ""

For i = 1 To UBound(QUESTION_NUMBER)
MSG = MSG & "Question" & " " & i & " " & "--- >" & " " & RND_NUM(i) & vbNewLine
Next i

MSG = MSG & vbNewLine & "Are you satisfied with these results?"

RESULT = MsgBox(MSG, vbInformation + vbYesNoCancel, "Randomization")
If RESULT = vbYes Then
'
End If
If RESULT = vbNo Then
GoTo Start
End If
If RESULT = vbCancel Then
Exit Sub
End If


Download Link

I will likely never use this, but I had to say this is a really impressive feat of technicalities achieved. Rock on, man.

Dude, your work is way more impressive than mine. 

Personally, I think this code is kind of sloppily written. It's passable as a proof of concept though. I just copied alot of this code from my stick figure quiz fighter game.

The application has been updated with several quality-of-life fixes, and it now can make a PDF Answer Sheet for you.