Excel VBA как связать класс и элемент управления?

Question

Я использую Excel 2003 с VBA, я динамически создаю элементы управления флажком на листе и хочу связать элементы управления VBA с классом, чтобы при щелчке на флажке событие было запущено, поэтому я могу что-то сделать.

Из того, что я прочитал, казалось бы, что создание пользовательского класса является решением, но, попробовав это, я не могу заставить его работать.

Мой пользовательский класс выглядит следующим образом:

Option Explicit 

    Public WithEvents cbBox As MSForms.checkbox 

    Private Sub cbBox_Change() 
     MsgBox "_CHANGE" 
    End Sub 

    Private Sub cbBox_Click() 
     MsgBox "_CLICK" 
    End Sub 

Мой код для создания флажков:

For Each varExisting In objColumns 
    'Insert the field name 
     objColumnHeadings.Cells(lngRow, 1).Value = varExisting 
    'Insert a checkbox to allow selection of the column 
     Set objCell = objColumnHeadings.Cells(lngRow, 2) 
     Dim objCBclass As clsCheckbox 
     Set objCBclass = New clsCheckbox 
     Set objCBclass.cbBox = ActiveSheet.OLEObjects.Add(_ 
            ClassType:="Forms.CheckBox.1" _ 
           , Left:=300 _ 
           , Top:=(objCell.Top + 2) _ 
           , Height:=10 _ 
           , Width:=9.6).Object 
     objCBclass.cbBox.Name = "chkbx" & lngRow 
     objCBclass.cbBox.Caption = "" 
     objCBclass.cbBox.BackColor = &H808080 
     objCBclass.cbBox.BackStyle = 0 
     objCBclass.cbBox.ForeColor = &H808080 
     objCheckboxes.Add objCBclass 
     lngRow = lngRow + 1 
    Next 

Флажки видны на листе, но когда я нажимаю на них, не окно сообщения отображается, поэтому ссылка на класс не работает.

Почему?

Редактировать ... Если после добавления флажков я перехожу в VB IDE и выбираю один из созданных флажков из списка элементов управления, а затем выберите «Щелчок» в раскрывающемся списке «Порядок», он вставляет код для вызова назад, который, если я добавлю в него окно сообщения, работает, когда я нажимаю на тот же флажок ... так как я могу достичь этого в коде? Я попытался записать макрос, чтобы сделать это, ничего не было записано.

Answer 1

Редактируйте S.Platten, прыгать на дно за то, как это помогло мне решить эту проблему ...

Из-за какой-то странной причины VBA не подключает события к элементу ActiveX элемента Sheet в том же рабочем цикле, в который они были добавлены. Итак, нам нужно выйти из цикла, который добавил элементы управления, а затем вызвать событие, добавляющее proc в следующем цикле. Application.OnTime помогает здесь.

Его кажется немного излишним, но это работает :)

Option Explicit 

Dim collChk   As Collection 
Dim timerTime 

Sub master() 

     '/ Add the CheckBoxes First 
     Call addControls 

     '<< Due to some weird reason, VBA doesn't hook up the events for Sheet's ActiveX control in the same 
     'execution cycle in which they were added. So, we need to come out of the cycle which added the controls 
     'and then invoke the event adding proc in next cycle. >> 

     '/ Start Timer. Timer will call the sub to add the events 
     Call StartTimer 
End Sub 

Sub addControls() 
    Dim ctrlChkBox  As MSForms.CheckBox 
    Dim objCell   As Range 
    Dim i    As Long 

    'Intialize the collection to hold the classes 
    Set collChk = New Collection 

    '/ Here Controls are added. No Events, yet. 
    For i = 1 To 10 
     Set objCell = Sheet1.Cells(i, 1) 
     Set ctrlChkBox = Sheet1.OLEObjects.Add(_ 
          ClassType:="Forms.CheckBox.1" _ 
         , Left:=1 _ 
         , Top:=(objCell.Top + 2) _ 
         , Height:=objCell.Height _ 
         , Width:=100).Object 
     ctrlChkBox.Name = "chkbx" & objCell.Row 
    Next 

End Sub 

Sub addEvents() 

    Dim ctrlChkBox  As MSForms.CheckBox 
    Dim objCBclass  As clsCheckBox 
    Dim x    As Object 


    'Intialize the collection to hold the classes 
    Set collChk = New Collection 

    '/ Here we assign the event handler 
    For Each x In Sheet1.OLEObjects 
     If x.OLEType = 2 Then 

     Set ctrlChkBox = x.Object 

     Set objCBclass = New clsCheckBox 
     Set objCBclass.cbBox = ctrlChkBox 

     collChk.Add objCBclass 
     Debug.Print x.Name 
     End If 
    Next 

    '/ Kill the timer 
    Call StopTimer 

End Sub 

Sub StartTimer() 
    timerTime = Now + TimeSerial(0, 0, 1) 
    Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _ 
     Schedule:=True 
End Sub 

Sub StopTimer() 
    On Error Resume Next 
    Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _ 
     Schedule:=False 
End Sub 

Класс модуля: clsCheckBox

Option Explicit 

    Public WithEvents cbBox As MSForms.CheckBox 

    Private Sub cbBox_Change() 
     MsgBox "_CHANGE" 
    End Sub 

    Private Sub cbBox_Click() 
     MsgBox "_CLICK" 
    End Sub 

Редактировать продолжение ...

Класс (clsCheckbox):

Option Explicit 

    Public WithEvents cbBox As MSForms.checkbox 

    Private Sub cbBox_Click() 
     MsgBox "_CLICK" 
    End Sub 

Module1

Public objCheckboxes As Collection 
    Public tmrTimer 

    Public Sub addEvents() 
     Dim objCheckbox As clsCheckbox 
     Dim objMSCheckbox As Object 
     Dim objControl As Object 

     Set objCheckboxes = New Collection 
     For Each objControl In Sheet1.OLEObjects 
      If objControl.OLEType = 2 _ 
      And objControl.progID = "Forms.CheckBox.1" Then 
       Set objMSCheckbox = objControl.Object 
       Set objCheckbox = New clsCheckbox 
       Set objCheckbox.cbBox = objMSCheckbox 
       objCheckboxes.Add objCheckbox 
      End If 
     Next 
     Call stopTimer 
    End Sub 

    Public Sub startTimer() 
     tmrTimer = Now + TimeSerial(0, 0, 1) 
     Application.OnTime EarliestTime:=tmrTimer _ 
         , Procedure:="addEvents" _ 
         , Schedule:=True 
    End Sub 

    Public Sub stopTimer() 
     On Error Resume Next 
     Application.OnTime EarliestTime:=tmrTimer _ 
         , Procedure:="addEvents" _ 
         , Schedule:=False 
    End Sub 

Код в листе, который добавляет элементы управления:

Dim objControl As MSForms.checkbox 
    For Each varExisting In objColumns 
    'Insert the field name 
     objColumnHeadings.Cells(lngRow, 1).Value = varExisting 
    'Insert a checkbox to allow selection of the column 
     Set objCell = objColumnHeadings.Cells(lngRow, 2) 
     Set objControl = ActiveSheet.OLEObjects.Add(_ 
            ClassType:="Forms.CheckBox.1" _ 
           , Left:=300 _ 
           , Top:=(objCell.Top + 2) _ 
           , Height:=10 _ 
           , Width:=9.6).Object 
     objControl.Name = "chkbx" & lngRow 
     objControl.Caption = "" 
     objControl.BackColor = &H808080 
     objControl.BackStyle = 0 
     objControl.ForeColor = &H808080 
     lngRow = lngRow + 1 
    Next 

Это не весь проект, но достаточно, чтобы продемонстрировать, как работает.

Answer 2

В настоящее время вы используете элементы управления ActiveX. Тем не менее, элементы управления ActiveX привязаны к определенным соглашениям об именах. Например: если вы вставляете кнопку ActiveX на листе и назовите ее btnMyButton, то суб должно быть указано btnMyButton_Click. То же самое относится к флажкам. Если вы вставляете новый флажок с именем CheckBox2, то имя субфайла должно быть CheckBox2_Click. Короче говоря, не может быть sub с именем cbBox_Change, связанным с любым флажком ActiveX.

Итак, что вам действительно нужно (с элементами управления ActiveX) - это способ изменить код VBA на листе. Но до сих пор я никогда не сталкивался с таким кодом (код VBA для изменения кода VBA на листе).

А намного проще будет, если вы захотите использовать form controls.

Следующий подраздел создаст флажок (контроль формы) и assign the macrotmpSO. Sub tmpSO (в отличие от подсистем для элементов управления ActiveX) не нужно размещать на листе, но может быть в любом модуле.

Sub Insert_CheckBox() 

Dim chk As CheckBox 

Set chk = ActiveSheet.CheckBoxes.Add(390.75, 216, 72, 72) 
chk.OnAction = "tmpSO" 

End Sub 

from control Поскольку звонит суб tmpSO вы можете использовать Application.Caller в этом подразделам и таким образом узнать, какой флажок был вызов этой суб.

Sub tmpSO() 

Debug.Print Application.Caller 

End Sub 

Это возвратит имя CheckBox. Таким образом, вы можете использовать эту единицу для всех своих флажков, какие-либо динамически обрабатывают их на основе их имен (возможно, используя Case Select).

Вот еще один пример tmpSO:

Sub tmpSO() 

With ThisWorkbook.Worksheets(1).CheckBoxes(Application.Caller) 
    MsgBox "The checkbox " & Application.Caller & Chr(10) & _ 
     "is currently " & IIf(.Value = 1, "", "not") & " checked." 
End With 

End Sub