对动态创建的切换按钮进行分组(以分组关闭/打开)并写入类

问题描述 投票:0回答:1

我有一个可能位置 (i) 的列表,并希望用户按偏好顺序排列。 因此,我编写了代码来创建“i”位置并分配了 ToggleButtons (= TB)。我得到一个 i x i TB 的字段,其中已选择“a”首选项(即,如果单击“下一步”,每个位置都有一个首选项)

Userform output for user to change order of preference

'create Toggle buttons
        Dim mpp         As Long
        Dim i           As Long
        Dim j           As Long
        Dim A_ij        As Long
        Dim TB          As MSForms.ToggleButton
        Dim txtBox      As MSForms.Label
'        Dim btnColl     As New Collection
        
        'A_ij = 0
        mpp = 1
        'read out how many "add" items
        For i = 1 To Sheets(1).Cells(11 + mpp, 5).Value

            'Toggle Buttons
            For j = 1 To Sheets(1).Cells(11 + mpp, 5).Value
                Set TB = MultiPage1.Pages(mpp - 1).Controls.Add("Forms.ToggleButton.1", "TB_" & i & "_" & j)
                TB.Name = i & j
                TB.Caption = j
                TB.Left = 5 + 20 * (j - 1)
                TB.width = 20
                TB.Height = 20
                TB.Top = 15 + ((i - 1) * 20)
                If TB.Caption = i Then
                    TB.Value = True
                    Else
                    TB.Value = False
                End If
                A_ij = TB.Name
                ReDim Preserve cmdArray(1 To A_ij)
                Set cmdArray(A_ij).CmdEvents = TB

                Set TB = Nothing
            Next j
            
            'Label boxes
            Set txtBox = MultiPage1.Pages(mpp - 1).Controls.Add("Forms.Label.1", "Label_" & i)
            txtBox.Caption = Sheets(1).Cells(i + 31, 4).Value
            txtBox.Left = 10 + 20 * (Sheets(1).Cells(11 + mpp, 5).Value)
            txtBox.width = 390
            txtBox.Top = 17 + ((i - 1) * 20)
            
            

        Next i

我现在想要实现/编写代码,如果用户在位置“Restaurant A”中按“1”,则 TB_6_1.Value 将设置为 True(自动),而该行中的所有其他值将设置为 False。

因此,我想将它们添加到每个 i 的数组或集合中(如果我正确阅读)(我找到了代码并且似乎可以工作 - >它运行,但我不太明白如何在课堂上读出)

我发现创建一个类

Option Explicit

Public WithEvents CmdEvents As MSForms.ToggleButton

Private Sub CmdEvents_Click()

    MsgBox Left(CmdEvents.Name, 1)
    Dim i As Long
    Dim mpp         As Long
    mpp = 1
    Dim ctl As Control
    
    For i = 1 To Sheets(1).Cells(11 + mpp, 5).Value
        'set TB_Left(CmdEvents.Name, 1)_i which isn't the one clicked to False; if i = name True (which is done by pressing it)

'        MsgBox cmdArray(Left(CmdEvents.Name, 1) & i).CmdEvents
        
'    For Each ctl In Me.Controls 'but want just those with name starting same i
'        If ctl.Name <> CmdEvents.Name Then
'            ctl.Value = False
'        End If
    Next i

End Sub 

理论上:我想检查我点击的 TB 的第一位数字,然后将具有相同第一位数字的所有其他 TB 设置为 false。 我希望能够在所有行的 Class1 中工作,因为我不知道我有多少个可能的位置。 (即考虑为每个 i 编写 Class i)

这篇文章给了我类代码的想法:https://www.access-programmers.co.uk/forums/threads/toggle-buttons.318583/

本文为我提供了用户窗体代码的结构:将 Sub 分配给动态定义的 CommandButton

本文有帮助:将代码分配给动态创建的按钮但是,我希望在单击“下一步”(命令按钮)以保存用户首选项之前对 TB 进行这些更改。所以我不确定将它们放在子/函数/类/模块的哪里。

更新: 我在课堂上找到了一种方法,可以将行中的所有 TB 设置为 false;但是,我意识到将它们设置为 false 是一个 Click 事件,因此循环会再次运行,所以我不确定如何保持按下的按钮为 true...

For Each ctl In Order.Controls 
            If Left(ctl.Name, 2) = Left(CmdEvents.Name, 2) Then 'And ctl.Name <> CmdEvents.Name
                ctl.Value = False
'                If ctl.Name = CmdEvents.Name Then
'                    ctl.Value = True
'                End If
            End If
        Next ctl

因为我知道我想调用的具体名称,所以我想知道是否可以调用这些名称而不是循环遍历所有控件。但是,我试图将 TB 设置为 false,这又会调用另一个 click_event。

For i = 1 To Sheets(1).Cells(11 + mpp, 5).Value
'        MsgBox Order.Controls(Left(CmdEvents.Name, 2) & i).Value
'        MsgBox i
'        MsgBox Right(CmdEvents.Name, 1)
        If Order.Controls(Left(CmdEvents.Name, 2) & i).Value And i <> Right(CmdEvents.Name, 1) Then
            nv = Order.Controls(Left(CmdEvents.Name, 2) & i).Name
            GoTo setF
'            Order.Controls(Left(CmdEvents.Name, 2) & i).Value = False
        End If
    Next i
setF:
    If nv = Order.Controls(Left(CmdEvents.Name, 2) & i).Name Then '<-- this line gives me a debug error when it changes one false and thus enters loop again
        Order.Controls(Left(CmdEvents.Name, 2) & i).Value = False
    End If
class controls togglebutton
1个回答
0
投票

我在课堂上做了更多的工作,并且能够解决 90% 的问题: colouring same preference red + hopping out

这是

class
代码:

Option Explicit

Public WithEvents CmdEvents As MSForms.ToggleButton

Private Sub CmdEvents_Click()

    'if Clicking off, do nothing
    'set backcolor to off
    If CmdEvents.Value = False Then
        CmdEvents.BackColor = vbButtonFace
        GoTo EndNothing
        Else
        CmdEvents.BackColor = RGB(0, 128, 64)
    End If
    'MsgBox "mpp: " & Left(CmdEvents.Name, 1) & vbCrLf & "i: " & Mid(CmdEvents.Name, 2, 1) ' reads out mpp and i
    Dim i As Long
    Dim mpp         As Long
    mpp = Left(CmdEvents.Name, 1)
    Dim ctl As Control
    Dim nv As Long
    nv = 0
    Dim trb As Long
'    Dim j As Long
        
    For i = 1 To Sheets(1).Cells(11 + mpp, 5).Value
        If Order.Controls(Left(CmdEvents.Name, 2) & i).Value And i <> Right(CmdEvents.Name, 1) Then
            nv = Order.Controls(Left(CmdEvents.Name, 2) & i).Name
            Order.Controls(Left(CmdEvents.Name, 2) & i).Value = False
        End If
    Next i

    'Colour Red if same preference
    For Each ctl In Order.Controls
        If Left(ctl.Name, 1) = mpp Then 'if control is a TB button
            If Left(ctl.Name, 1) = Left(CmdEvents.Name, 1) And Right(ctl.Name, 1) = Right(CmdEvents.Name, 1) And ctl.Value = True And CmdEvents.Value = True And ctl.Name <> CmdEvents.Name Then
                ctl.BackColor = RGB(120, 105, 2) 'red
                CmdEvents.BackColor = RGB(120, 105, 2) 'red
                Else
                'reset green colour
                If Left(ctl.Name, 1) = Left(CmdEvents.Name, 1) And Right(ctl.Name, 1) = Right(CmdEvents.Name, 1) And ctl.Value = True And ctl.Name <> CmdEvents.Name Then
                   'only if not two buttons are pressed in column
                   'need to change "old" column colour as well
'                   For j = 1 To Sheets(1).Cells(11 + mpp, 5).Value
                    trb = 0
                    For i = 1 To Sheets(1).Cells(11 + mpp, 5).Value
                         If Order.Controls(Left(CmdEvents.Name, 1) & i & Right(CmdEvents.Name, 1)).Value Then 'j
                             trb = trb + 1
                         End If
                     Next i
                     MsgBox trb
                    If trb = 1 Then
                         ctl.BackColor = RGB(0, 128, 64) 'green
                    End If
'                  Next j
                End If
            End If
        End If
    Next ctl
    
EndNothing:
End Sub

我还在多页中添加了一些颜色代码和下一页来订单初始化:

For mpp = 1 To 2 'added version for alternative date
 ' the same
TB.Name = mpp & i & j 'altered for second "date" to work
 ' the same
If TB.Caption = i Then
                        TB.Value = True
                        TB.BackColor = RGB(0, 128, 64) 'added to give green background'
 ' the same
Next mpp
End Sub

我现在唯一的问题是,如果你现在单击“7”(并再次使其正确),其他 7 保持红色:

© www.soinside.com 2019 - 2024. All rights reserved.