런타임에 생성 된 OLEObject CommandButtons에 대한 이벤트 처리

Question

저는이 문제에 대해 지금까지 고심하고 있습니다 ... 나는 아주 간단한 것을하고 싶습니다. 런타임에 여러 명령 단추를 작성한 다음이 명령 단추에 대한 이벤트를 하나의 프로 시저로 처리하려고합니다. 그래서 자동화를 처리하기 위해 "withevents"클래스를 만들었지 만 코드가 작동하지 않습니다. Test()를 실행하면 CommandButton이 만들어 지지만 클릭하면 아무런 메시지 상자 응답도 나타나지 않습니다 ... 오류를 찾을 수 없습니다. 도움이된다면 좋을 것입니다 !!

클래스 cTest

Public WithEvents Button As MSForms.CommandButton 

Public Sub Button_Click() 
s = MsgBox("Hello", vbOKOnly) 
End Sub 

모듈 1

Public TestCollection As Collection 

Sub Test() 

Set TestCollection = New Collection 
Dim Btn As CommandButton 
Dim OLEBtnObj As cTest 
Set OLEBtnObj = New cTest 
Set Btn = Sheet1.OLEObjects.Add(ClassType:="Forms.CommandButton.1", link:=False,_ DisplayAsIcon:=False, Left:=368.25, Top:=51, Width:=44.25, Height:=24).Object 
Set OLEBtnObj.Button = Btn 
TestCollection.Add Item:=OLEBtnObj 

End Sub 

Answer 1

나는 :-) 하나 오히려 실용적 해결책을 가지고 있습니다. 테스트하려면 다음 코드를 Sheet1 클래스 모듈에 삽입하십시오.

각 새 Sheet1 단추에 대해 처리 된 새 이벤트가 추가됩니다. 이 이벤트 처리기는 공통 이벤트 처리기을 실행하고 클릭 한 명령 단추의 이름을 전달합니다.

' Standard Module 
Sub test() 
    ' adds three buttons to Sheet1 with click-event handlers 
    Sheet1.AddButton 
    ActiveCell.Offset(5, 0).Activate 
    Sheet1.AddButton 
    ActiveCell.Offset(5, 0).Activate 
    Sheet1.AddButton 
End Sub 

' Sheet1 Class Module 
Option Explicit 

' Add Microsoft Visual Basic For Applications Extensibility 

Public Function AddButton() As MSForms.CommandButton 
    Dim msFormsCommandButton As MSForms.CommandButton 
    Set msFormsCommandButton = Me.OLEObjects.Add(ClassType:="Forms.CommandButton.1").Object 
    CreateEventHandler msFormsCommandButton.Name 
    Set AddButton = msFormsCommandButton 
End Function 

Private Sub CommonButton_Click(ByVal buttonName As String) 
    MsgBox "You clicked button [" & buttonName & "]" 
End Sub 

Private Sub CreateEventHandler(ByVal buttonName As String) 
    Dim VBComp As VBIDE.VBComponent 
    Dim CodeMod As VBIDE.CodeModule 
    Dim codeText As String 
    Dim LineNum As Long 

    Set VBComp = ThisWorkbook.VBProject.VBComponents(Me.CodeName) 
    Set CodeMod = VBComp.CodeModule 
    LineNum = CodeMod.CountOfLines + 1 

    codeText = codeText & "Private Sub " & buttonName & "_Click()" & vbCrLf 
    codeText = codeText & " Dim buttonName As String" & vbCrLf 
    codeText = codeText & " buttonName = """ & buttonName & "" & vbCrLf 
    codeText = codeText & " CommonButton_Click buttonName" & vbCrLf 
    codeText = codeText & "End Sub" 
    CodeMod.InsertLines LineNum, codeText 
End Sub