vba 以编程方式为动态生成的标签插入点击事件代码不起作用

Programatically inserting click event code for dynamically generated label not working

提问by Akki J

I am inserting a ActiveX control Label in excel sheet using VBA code. Now after inserting the button, I am trying to insert the click event code but its not working. Below is the code:

我正在使用 VBA 代码在 Excel 工作表中插入 ActiveX 控件标签。现在插入按钮后，我试图插入点击事件代码，但它不起作用。下面是代码：

Public Function AddButton(strSheetName, counter)
Dim btn As OLEObject
Dim cLeft, cTop, cWidth, cHeight
Dim CodeModule As Object
    With Worksheets(strSheetName).Range("J" & (6 + counter))
        cLeft = .Left + 1
        cTop = .Top + 1
        cWidth = .Width - 2
        cHeight = .Height - 2
    End With
    With Worksheets(strSheetName)
        Set btn = .OLEObjects.Add(ClassType:="Forms.Label.1", Link:=True, DisplayAsIcon:=True, Left:=cLeft, Top:=cTop, Width:=cWidth, Height:=cHeight)
    End With
    btn.Object.Caption = "Add New"
    btn.Name = Left(strSheetName, 3) & counter
    Set CodeModule = ActiveWorkbook.VBProject.VBComponents.VBE.ActiveCodePane.CodeModule
    CodeModule.InsertLines CodeModule.CreateEventProc("Click", btn.Name) + 1, vbTab & "MsgBox ""Hello world"""
End Function

Button is getting inserted but click event code is not working. When I click nothing happens. Also this function is getting called in a loop. First time it adds button and then as soon as it tries to add click event code, loop terminates which means there is an error.

按钮正在插入，但单击事件代码不起作用。当我点击什么都没有发生。此函数也在循环中被调用。第一次添加按钮，然后尝试添加单击事件代码时，循环终止，这意味着存在错误。

Any help?

有什么帮助吗？

Thanks in advance.

提前致谢。

回答by Siddharth Rout

I believe this is in continuation to your last question.

我相信这是您最后一个问题的延续。

Is this what you are trying?

这是你正在尝试的吗？

Option Explicit

Sub Sample()
    Dim i As Long

    For i = 1 To 5
        AddButton "Sheet1", i
    Next i
End Sub

Public Sub AddButton(strSheetName As String, counter As Long)
    Dim btn As OLEObject
    Dim cLeft, cTop, cWidth, cHeight

    With Worksheets(strSheetName).Range("J" & (6 + counter))
        cLeft = .Left
        cTop = .Top
        cWidth = .Width
        cHeight = .Height
    End With
    With Worksheets(strSheetName)
        Set btn = .OLEObjects.Add(ClassType:="Forms.Label.1", Link:=True, _
        DisplayAsIcon:=False, Left:=cLeft, Top:=cTop, Width:=cWidth, _
        Height:=cHeight)
    End With
    btn.Object.Caption = "Add New"

    btn.Name = Left(strSheetName, 3) & counter

    With ActiveWorkbook.VBProject.VBComponents( _
    ActiveWorkbook.Worksheets(strSheetName).CodeName).CodeModule
        .InsertLines Line:=.CreateEventProc("Click", btn.Name) + 1, _
        String:=vbCrLf & _
        "MsgBox ""Hello world"""
    End With
End Sub

FOLLOWUP

跟进

yes, Clean the code from a particular sheet of entire Excel project. That's what is the requirement – user1269291 54 secs ago

是的，从整个 Excel 项目的特定工作表中清除代码。这就是要求 – user1269291 54 秒前

Option Explicit

Sub Sample()
    Dim strSheetName As String

    strSheetName = "Sheet1"

    With ActiveWorkbook.VBProject.VBComponents( _
    ActiveWorkbook.Worksheets(strSheetName).CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
    End With
End Sub