Handling Events for OLEObject CommandButtons created at Runtime

前端 未结 1 1964
不知归路
不知归路 2020-12-07 03:01

I have struggled with this problem for while now...I want to do something very simple. I want to create multiple commandbuttons at runtime, and then handle events for these

相关标签:
1条回答
  • 2020-12-07 03:40

    I have one rather impractical solution :-). To test it place the following code in Sheet1 Class Module.

    For each new Sheet1-button a new event handled will be added. This event handler will execute the common event handler and pass the name of the clicked command button to it.

    ' 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
    
    0 讨论(0)
提交回复
热议问题