将事件分配给多个动态标签

Question

在 VBA 中，我很难将事件分配给动态创建的标签。我想将 tbEvents_Click 分配给每个标签。

我有班级 Class1

Option Explicit

Public WithEvents tbEvents As MSForms.Label


Private Sub tbEvents_Click()
   
        MsgBox "You clicked label"

End Sub

和表格 frMain

Dim HH As Long, VV As Long

Public tbPin As MSForms.Label
Dim Question As New Class1

Dim objMyEventClass As New Class1
  


Option Explicit

Private Sub UserForm_Initialize()
    
    HH = shQuestions.Range("C1").CurrentRegion.Columns.Count
    VV = shQuestions.Range("A3").CurrentRegion.Rows.Count
  
End Sub

Private Sub addQuestions()


    Dim i As Long, j As Long
    Dim mmm As String

    For i = 1 To VV + 1
        
        For j = 1 To HH + 1
    
        Set tbPin = frMain.Controls.Add("Forms.Label.1", "label" & i & j, True)
            
            With tbPin
                              
                If i = 1 Then
                    .Caption = "Question" & i & j
                    .Height = 80
                    .Top = 230
                    .BackColor = RGB(100, 116, 168)
                    
                Else

                    .Caption = "labelPoints" & i & j
                    .Height = 460 / VV
                    .Top = 310 + (i - 2) * (460 / VV)
                    .BackColor = RGB(0, 116, 168)                 

                End If

                           
                If j = 1 Then
                    .Caption = "Points" & i & j
                    .Width = 325
                    .Left = 50
                    .BackColor = RGB(100, 116, 168)
                    
                Else

                    .Width = 750 / HH
                    .Left = 375 + (j - 2) * (750 / HH)
                                       
                    Set objMyEventClass.tbEvents = tbPin

                End If
                
            End With
        Next j
    Next i
    
End Sub

我希望如此

Set objMyEventClass.tbEvents = tbPin

会将事件分配给所有标签。但它只会将事件添加到最后创建的标签中。我究竟做错了什么？谢谢。

Answer 1

您正在创建

Class1

的多个实例（每个标签一个），因此您需要将它们存储在某个地方，例如集合，这样一旦您的

addQuestions

子完成，它们就可以全部保留在范围内。

这是一个简化的例子

Class1：

Public WithEvents lblEvents As MSForms.Label

Private Sub lblEvents_Click()
    MsgBox "You clicked label " & lblEvents.Caption
End Sub

用户表单：

Option Explicit

Dim Questions As Collection 'needs to hold >1 Class1 object

Private Sub UserForm_Initialize()
    addQuestions 10, 10
End Sub

'create and return an instance of Class1
Function getLabelHandler(lbl As MSForms.Label)
    Set getLabelHandler = New Class1
    Set getLabelHandler.lblEvents = lbl
End Function


Private Sub addQuestions(numRows As Long, numCols As Long)
    Dim r As Long, c As Long, lbl As MSForms.Label
    Set Questions = New Collection

    For r = 1 To numRows
        For c = 1 To numCols
            Set lbl = Me.Controls.Add("Forms.Label.1", "lblR" & r & "C" & c, True) 'Me
            Questions.Add getLabelHandler(lbl)
            lbl.Caption = "R" & r & "-C" & c
            lbl.BackColor = IIf(r = 1 Or c = 1, RGB(100, 116, 168), RGB(0, 116, 168))
            lbl.Top = 20 + (r - 1) * 20
            lbl.Left = 20 + (c - 1) * 40
            lbl.Height = 19
            lbl.Width = 39
        Next c
    Next r
End Sub