Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
2.2k views
in Technique[技术] by (71.8m points)

excel - Programatically inserting click event code for dynamically generated label not working

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:

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.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...