vba - For Each 循环仅触发一次

Question

我正在制作一个四连子游戏来学习一些 VBA。

我有一个未绑定(bind)的表单，其中包含游戏片段( token )的按钮。用于选择要删除标记的列的选项组。一个文本框(隐藏)，表示 token 将放置在哪一行。

如果我在文本框中手动输入一个数字，然后点击下拉按钮，它就会按预期工作。填写 token 并将其添加到正确的文本框中。

示例:
将 1 放入 txtR1，点击放置按钮。
token 已填写，txtR1 现在显示 2，再次点击下拉按钮，什么也没有。如果我手动将 2 放入 txtR1 中，那么它会按预期工作。

当文本框显示已更新时，是否未更新？

我在 if 语句中排列了代码 str 和 row，并尝试在其中添加保存并刷新。

Private Sub drop()
    
    Dim Token As Control
    Dim Row As Control
    Dim r As Integer
    Dim c As Integer
    Dim str As String
    
    c = Me.frmCol
    str = "txtR" & c
    Set Row = Me(str)
    r = Row
    
    For Each Token In Controls
    
        If InStr(Token.Tag, "C" & c) Then
    
            If Right(Token.name, 1) = Row Then
            
                Token.BackStyle = 1
                Token.BackColor = vbBlue
                Row = r + 1
                Exit Sub
                
            End If
    
        End If
        
    Next Token
    
End Sub

Answer 1

考虑使用数字后缀控制命名而不循环设置 token 颜色但使用循环重置游戏的替代方案:

Private Sub optDrop_Click()
Dim r As Integer
Dim c As Integer
c = Me.optDrop
r = Me("tbx" & c) + 1
If Me("tbx" & c) = 6 Then
    MsgBox "This column is full. Pick another."
Else
    Me("box" & c & r).BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
    Me("tbx" & c) = Me("tbx" & c) + 1
    Me.tbxPlayer = IIf(Me.tbxPlayer = "Player 1", "Player 2", "Player 1")
    Me.tbxPlayer.BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
End If
Me.optDrop = 0
End Sub

Private Sub btnReset_Click()
Dim c As Integer, r As Integer
Me.tbxPlayer = "Player 1"
Me.tbxPlayer.BackColor = vbCyan
For c = 1 To 7
    For r = 1 To 6
        Me("box" & c & r).BackColor = vbWhite
    Next
    Me("tbx" & c) = 0
Next
End Sub

矩形控件用于标记，optDrop 是选项组框架控件。

还没有想出代码来检查连续 4 个并宣布获胜者。可能超出了我的能力和兴趣。

奖励:如果您想观看代币“掉落”，请考虑:

Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)

Private Sub optDrop_Click()
Dim r As Integer, c As Integer, x As Integer, dteD As Date
c = Me.optDrop
r = Me("tbx" & c) + 1
If Me("tbx" & c) = 6 Then
    MsgBox "This column is full. Pick another."
Else
    For x = 6 To r Step -1
        Me("box" & c & x).BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
        dteD = Now()
        Do
            Sleep 300
            DoEvents
        Loop Until Now >= dteD
        Me("box" & c & x).BackColor = vbWhite
    Next
    Me("box" & c & r).BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
    Me("tbx" & c) = Me("tbx" & c) + 1
    Me.tbxPlayer = IIf(Me.tbxPlayer = "Player 1", "Player 2", "Player 1")
    Me.tbxPlayer.BackColor = IIf(Me.tbxPlayer = "Player 1", vbCyan, vbMagenta)
End If
Me.optDrop = 0
End Sub

我将切换按钮移至列顶部，以便获得更多“丢弃” token 的感觉。