Question

我正在使用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

按钮已插入，但点击事件代码无效。当我点击没有任何反应。此函数也在循环中调用。第一次添加按钮，然后一旦尝试添加点击事件代码，循环终止，这意味着有错误。

任何帮助？

提前致谢。

Answer 1

我相信这是对你上一个问题的继续。

这是你在尝试的吗？

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

<强>后续

是的，清理整个Excel项目的特定表单中的代码。那是什么要求 - 用户1269691 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

以编程方式插入点击事件代码，使动态生成的标签无效

1 个答案: