0

我正在为我所在的组织制作一个 PowerPoint Escape Room。为了加入更多有趣和复杂的谜题，我尝试在 VBA 中涉足，以便让这些谜题栩栩如生。其中之一就是下图中的这个谜题：

逃生室地球颜色序列游戏

简而言之，这些线索将引导玩家确定他们需要将红-金-绿-金颜色序列输入到地球下方的圆圈中。我已经把颜色输入下来了。这是该步骤的代码，灵感来自本视频 ( https://www.youtube.com/watch?v=xT7XW9maPwo ) 中的 Bhavesh Shaha：

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

就其预期目的而言，上述代码完美运行。

我现在的问题是：如果所有圆圈的颜色都正确，有没有办法让当前幻灯片移到下一张幻灯片？我尝试将其作为“Enter”按钮的宏，但未成功：

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

从理论上讲，这个宏会将玩家带到下一张幻灯片，他们可以在其中单击超链接到下一步的键。这张幻灯片如下图所示：

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

非常感谢您的帮助和考虑！

4

1 回答 1

0

我使用以下设置在 Excel 中测试了以下功能。

  • 4 种形状，称为“Oval 0”到“Oval 3”
  • 4 种形状，称为“Square 0”到 Square 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-base，因为我首先开发了这个功能。该数组被声明为 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

我有对颜色和形状进行相同编号的想法，但后来发现手头的任务不需要这样做。但是，该功能和想法可能对您有用。

于 2021-04-15T01:25:42.300 回答