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

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

Answer 1

I might do something like this pseudo-code
While not all buttons placed
get a random number between 1 and ButtonCount
if that location not already filled, fill it with the next button
wend

To get a random number, look up the Rnd function in help file, as well as Randomize.