How can I use VBA (Excel) to randomise the placement of quiz answer buttons on Powerpoint slides? - excel

Question

Background:
I'm trying to create a quiz using powerpoint where there are four buttons on each slide (Correct Answer, Wrong Answer, Wrong Answer, Wrong Answer). Depending which is selected, the user is redirected to a different slide. And to make things more difficult for the players, I'm wanting to randomise the location of the answer buttons e.g. randomly swap the correct answer location, with the wrong answer location etc.
Presentation and Spreadsheet files on OneDrive
Target:
I'm trying to use vba through excel to first find the top and left co-ordinates for each shape, on each slide. And then loop through the presentation a second time, to randomise the placement of my answer buttons (randomly swap them around).
Clarification:
Each of my answer buttons are made up of two parts, a transparent rectangle shape (which has an action link to a particular slide depending whether or not the user selected the correct or wrong answer) as well as a text field (with a red background) which says either wrong or correct answer.
Problem:
I'm currently having problems storing the top and left co-ordinates for each shape, on each slide. So I can then loop through each slide and randomise the placement of my potential answer buttons.
So Far
I'm able to access and store the top and left locations of each shape locally, but I'm not able to store them in my nested classes. Instead when I attempt to pass through the array of shapes found on a particular slide to one of my classes, each time I attempt to access this passed through array, it shows as empty even though I know values are being passed through.
Any suggestions would be fantastic
My Code:
Module 1
Option Explicit
Sub CreateQuiz()
Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object
Dim oPPShape As Object
Dim FlName As String
'~~> Change this to the relevant file
FlName = ThisWorkbook.Path & "/Quiz.pptm"
'~~> Establish an PowerPoint application object
On Error Resume Next
Set oPPApp = GetObject(, "PowerPoint.Application")
If Err.Number <> 0 Then
Set oPPApp = CreateObject("PowerPoint.Application")
End If
oPPApp.Visible = False
Set oPPPrsn = oPPApp.Presentations.Open(FlName, True)
Dim currentPresentation As New Presentation
Dim numSlides As Integer
numSlides = 0
For Each oPPSlide In oPPPrsn.Slides
Dim currentSlide As New shapesOnSlide
Dim numShapes As Integer
numShapes = 0
For Each oPPShape In oPPSlide.shapes
Dim currentShape As New shapeDetails
currentShape.slideNumber = oPPSlide.slideNumber
currentShape.name = oPPShape.name
currentShape.left = oPPShape.left
currentShape.top = oPPShape.top
currentSlide.size = numShapes
currentSlide.aShape = currentShape
numShapes = numShapes + 1
Next
currentPresentation.Slide(numSlides) = currentSlide
numSlides = numSlides + 1
Next
currentPresentation.printAll
End Sub
ShapeDetails Class
Private ElementSlideNumber As Integer
Private ElementName As String
Private ElementLeft As Double
Private ElementTop As Double
Public Property Get slideNumber() As Integer
slideNumber = ElementSlideNumber
End Property
Public Property Let slideNumber(value As Integer)
ElementSlideNumber = value
End Property
Public Property Get name() As String
name = ElementName
End Property
Public Property Let name(value As String)
ElementName = value
End Property
Public Property Get left() As Double
left = ElementLeft
End Property
Public Property Let left(value As Double)
ElementLeft = value
End Property
Public Property Get top() As Double
top = ElementTop
End Property
Public Property Let top(value As Double)
ElementTop = value
End Property
Public Sub PrintVars()
Debug.Print "Slide: " & slideNumber & " Position: " & left & "," & top & ", Slide Name: " & name
End Sub
shapesonSlide Class
Private allShapes(99999) As Variant
Private collectionSize As Integer
Public Property Get size() As Integer
size = collectionSize
End Property
Public Property Let size(value As Integer)
collectionSize = value
End Property
Public Property Get aShape() As Variant
shapes = allShapes(collectionSize)
End Property
Public Property Let aShape(value As Variant)
allShapes(collectionSize) = value
End Property
Public Property Get everyShape() As Variant
everyShape = allShapes()
End Property
Public Property Let everyShape(value As Variant)
everyShape = value
End Property
Sub compareSizes(newIndex As Integer)
If (newIndex > collectionSize) Then
collectionSize = newIndex
End If
End Sub
Public Sub printSize()
Debug.Print collectionSize
End Sub
Presentation Class
Private allSlides() As shapesOnSlide
Private Sub Class_Initialize()
ReDim allSlides(0)
End Sub
Public Property Get Slides() As shapesOnSlide()
Slides = allSlides
End Property
Public Property Get Slide(index As Integer) As shapesOnSlide
Slide = allSlides(index)
End Property
Public Property Let Slide(index As Integer, currentSlide As shapesOnSlide)
If index > UBound(allSlides) Then ReDim Preserve allSlides(index)
allSlides(index) = currentSlide
End Property
Public Sub printAll()
For Each currentSlide In allSlides
For Each currentShape In currentSlide.everyShape
Debug.Print currentShape.name
Next
Next
End Sub