在PowerPoint中使用VBA更正颜色序列游戏

Question

我正在为我所在的一个组织制作一个PowerPoint逃生室。为了融入更多有趣和复杂的谜题，我试着用VBA把这些谜题变成现实。其中之一就是下图中的这个谜题：

逃生室地球仪彩色序列游戏

简而言之，这些线索将引导玩家确定他们需要在地球仪下面的圆圈中输入红-金-绿-金的颜色序列。我把颜色输入记下来了。以下是该步骤的代码，灵感来自本视频中的巴维什·沙哈(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

就其预期目的而言，上述代码可以完美地工作。

我现在的问题是：如果所有的圆圈都有正确的颜色，是否有办法将当前幻灯片移到下一张幻灯片？我曾试图将其作为"；输入"；按钮：

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

理论上，这个宏将把玩家带到下一张幻灯片，在那里他们可以点击超链接到下一步的键。此幻灯片如下图所示：

输入正确的颜色序列后的到达幻灯片

提前感谢您的帮助和考虑！

Answer 1

我用以下设置在Excel中测试了下面的函数。

• 4个被称为"；椭圆形0〃；至"；椭圆形3">
• 4个形状称为"；正方形0〃；到方块3">

该代码指的是ActiveSheet。请将其替换为相应的PP等效物。

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

"；秘密"；是在命名形状以匹配功能的要求。如果发现填充颜色有差异，函数将提前终止并返回False。如果循环运行到最后而没有中断，则循环计数器将为-1，最终测试将使函数返回True。

顺便说一句，对于上面的解决方案，你也可以从1开始对形状进行编号。我选择0基数是因为我首先开发了这个函数。数组被声明为Public，它自然是基于0的。

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

我曾想过将颜色和形状编号相同，但后来发现手头的任务不需要这样做。然而，这个功能和想法可能对你有用。