代码之家 › 专栏 › 技术社区 › Sunny Sampath

处理在运行时创建的OLEObject命令按钮的事件

commandbutton ole event-handling vba events

Sunny Sampath · 技术社区 · 11 年前

我已经和这个问题斗争了一段时间。。。我想做一些非常简单的事情。我想在运行时创建多个命令按钮,然后用一个过程处理这些命令按钮的事件。因此,我构建了一个“withevents”类来处理自动化,但我的代码不起作用。当我运行Test()时,会创建CommandButton,但当我点击它时……没有消息框响应。。。我找不到错误。。请提供任何帮助都会很棒!!

c级测试

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

1 回复 | 直到 11 年前

gembird 2 年前

我有一个相当不切实际的解决方案。要测试它,请将以下代码放入 图纸类模块 (见附图)。这个 Me.CodeName 指 Code-Name 纸张的。

对于每个新的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

推荐文章

Pikachu620 · 可以对事件列表进行排序吗?

2 年前

ManP22 · 我想在同一次单击中调用两个常量

2 年前

Pepe · 如何在JavaScript中的函数之间恢复/传递事件对象

2 年前

andycrt · TypeError:路径。join不是函数(在我的handleEvents.js文件中得到错误)

2 年前

Steve Proschenko · bash中的Nagios事件处理程序脚本,用于重新启动服务,如果服务未启动,则在满足条件之前不要重新启动下一个服务

6 年前

NJM · 最新版本的firefox和chrome版本及javascript

6 年前

Juan Salvador Portugal · javascript更改输入值时触发更改或输入

6 年前

Mor Sagmon · 关闭wx。通过单击另一个类中的按钮,从面板中的事件处理程序中创建对话框

6 年前

Thomas Mavrofides · jQuery取消绑定事件处理程序不工作

6 年前

Jaime Montoya · jQuery中submit()事件的事件委派

6 年前