CODEWITHSUNDEEP
vbapowerpointpowerpoint-2013powerpoint-2016
pching
pching

Reputation: 1

Correct Sequence of Colors Game using VBA in PowerPoint

I'm in the process of making a PowerPoint Escape Room for an organization I'm in. In order to incorporate more interesting and complex puzzles, I've tried to get my feet wet in VBA in order to bring such puzzles to life. One of these is this puzzle pictured below:

escape room globe color sequence game

To put it short, the clues would lead the players to determine that they need to input a red-gold-green-gold color sequence into the circles underneath the globe. I've got the color input down. Here is the code for that step, inspired by Bhavesh Shaha in this video (https://www.youtube.com/watch?v=xT7XW9maPwo):

Dim RGB As Variant

Sub ChooseColor(oSh As Shape)
RGB = oSh.Fill.ForeColor.RGB
End Sub

Sub CircleColor(oSh As Shape)
oSh.Fill.ForeColor.RGB = RGB
End Sub

For its intended purpose, the above code works perfectly.

My question now is this: is there a way that if all of the circles had the correct color, the current slide would move to the next slide? I've tried, unsuccessfully, to make this as a macro for the "Enter" button:

Dim oSh As Shape
Dim oSl As Slide

Sub GlobeKey()

If .oSh(1).Fill.ForeColor.RGB = RGB(255, 0, 0) Then
    If .oSh(2).Fill.ForeColor.RGB = RGB(255, 192, 0) Then
        If .oSh(3).Fill.ForeColor.RGB = RGB(0, 176, 80) Then
            If .oSh(4).Fill.ForeColor.RGB = RGB(255, 192, 0) Then
            ActivePresentation.SlideShowWindow.View.Next
            End If
        End If
    End If
End If
End Sub

This macro would, theoretically, take the players to this next slide, where they can click the key that hyperlinks them to the next step. This slide is pictured below:

arrival slide after correct color sequence is input

Thanks so much in advance for your help and consideration!

Upvotes: 0

Views: 151

Answers (1)

Variatus
Variatus

Reputation: 14373

I tested the function below in Excel with the following setup.

  • 4 shapes called "Oval 0" to "Oval 3"
  • 4 shapes called "Square 0" to Square 3"

The code refers to the ActiveSheet. Please replace this with the appropriate PP equivalent.

Private Function OpenSesame() As Boolean
    ' 220
    ' return True if all colours match
    
    Dim i           As Long             ' loop counter
    
    For i = 3 To 0 Step -1
        With ActiveSheet
            If .Shapes("Oval " & i).Fill.ForeColor.RGB <> _
               .Shapes("Square " & i).Fill.ForeColor.RGB Then Exit For
        End With
    Next i
    OpenSesame = (i = True)
End Function

The "secret" is in the naming of the shapes to match the requirement of the function. If a difference in fill colour is found the function will terminate early and return False. If the loop runs to the end without interruption the loop counter will be -1 and the final test will make the function return True.

BTW, for the above solution you could just as well number the shapes from 1 and up. I chose a 0-base because I first developed this function. The array was declared as Public and it's naturally 0-based.

Private Function ColorIndex(Shp As Shape) As Long
    ' 220
    ' return -1 if not found
    
    Dim Colors      As Variant
    
    ' the index numbers match the shape numbers (0 and up)
    Colors = Array(vbRed, vbYellow, vbGreen, vbBlue)
    
    For ColorIndex = UBound(Colors) To 0 Step -1
        If Shp.Fill.ForeColor.RGB = Colors(ColorIndex) Then Exit For
    Next ColorIndex
End Function

I had the idea of numbering the colours and the shapes identically but later found that this isn't needed for the task at hand. The function and the idea may be useful to you, however.

Upvotes: 0

Related Questions