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.
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).
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.
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.
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
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
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
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
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