时间戳

首页 > 解决方案 > For Each 循环只触发一次

vba - For Each 循环只触发一次

问题描述

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

我有一个未绑定的表单，其中包含游戏块（令牌）的按钮。用于选择要删除令牌的列的选项组。一个文本框（隐藏），表示要放置令牌的行。

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

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

当它显示它时，txtbox 是否没有更新？

我在 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

在此处输入图像描述

标签： vbams-access

解决方案

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

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

我将切换按钮移到了列的顶部，因此可以获得更多“丢弃”令牌的感觉。

推荐阅读