CODEWITHSUNDEEP
vbabuttonexcelspreadsheet
Ank
Ank

Reputation: 6260

Create a command button and assign event to it in a program

I found this code online and tweaked it a bit for my need to programmatically add a command button to a spreadsheet and assign an event to it. It works well

Sub AddComm_button()
  Set mybutton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
    Left:=126, Top:=96, Width:=126.75, Height:=25.5)
  mybutton.Name = "abcbutton"
  Call Modify_CommButton
End Sub

Sub Modify_CommButton()
  Dim LineNum As Long 'Line number in module
  Dim SubName As String 'Event to change as text
  Dim Proc As String 'Procedure string
  Dim EndS As String 'End sub string
  Dim Ap As String 'Apostrophe
  Dim Tabs As String 'Tab
  Dim LF As String 'Line feed or carriage return

  Ap = Chr(34)
  Tabs = Chr(9)
  LF = Chr(13)
  EndS = "End Sub"
  SubName = "Private Sub abcbutton_Click()" & LF
  Proc = Tabs & "MsgBox " & Ap & "Testing " & Ap & LF
  Proc = Proc & "End Sub" & LF
  Set ModEvent = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
  With ModEvent
    LineNum = .CountOfLines + 1
    .InsertLines LineNum, SubName & Proc & EndS  
  End With
End Sub

The following code appends my original program with this

Private Sub abcbutton_Click()
   MsgBox "Testing "
End Sub

and hence giving it a click event. How to I remove the appended part after my program is done. Right now when I run my program the second time, it already has the method abcbutton_Click() in it and it throws an error.

Thanks Original Source : http://www.mrexcel.com/archive/VBA/5348a.html

Upvotes: 4

Views: 9851

Answers (1)

competent_tech
competent_tech

Reputation: 44921

I think what you need to do is ensure the button is only added once.

Sub AddComm_button()
    Dim obj As OLEObject
    Dim fFoundIt As Boolean = False
    For Each obj In ActiveSheet.OLEObjects
        If TypeOf obj.Object Is MSForms.CommandButton Then
            If obj.Name = "abcbutton" Then
                fFoundIt = True
                Exit For
            End If
        End If
    Next

    If Not fFoundIt Then
       Set mybutton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1",Left:=126, Top:=96, Width:=126.75, Height:=25.5)
       mybutton.Name = "abcbutton"
       Call Modify_CommButton
    End if
End Sub

Also, you have a typo in your sub creation:

Proc = Proc & "End If" & LF

should be

Proc = Proc & "End Sub" & LF

Update with method to remove the code

Sub RemoveProcedure(sProcedureName As String)

    Set ModEvent = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule

    Dim wCurrLine As Integer
    Dim wFirstLine As Integer

    ' See if the method name exists
    For wCurrLine = 1 To ModEvent.CountOfLines
        Dim sCurrLine As String
        sCurrLine = ModEvent.Lines(wCurrLine, 1)
        If InStr(1, sCurrLine, sProcedureName, vbTextCompare) > 0 Then
            wFirstLine = wCurrLine
            Exit For
        End If
    Next

    ' If it does exist, remove it
    If wFirstLine <> 0 Then
        ' Start on the line after the first line
        For wCurrLine = wFirstLine + 1 To ModEvent.CountOfLines
            Dim sCurrLine As String
            sCurrLine = ModEvent.Lines(wCurrLine, 1)
            ' Found end sub
            If InStr(1, sCurrLine, "End Sub", vbTextCompare) > 0 Then
                ' So delete the lines
                ModEvent.DeleteLines wFirstLine, (wCurrLine + 1) - wFirstLine
                Exit For
            End If
        Next
    End If

End Sub

Upvotes: 6

Related Questions