vba - 在程序中创建命令按钮并为其分配事件

Question

我在网上找到了这段代码，并对其进行了一些调整，以满足我以编程方式将命令按钮添加到电子表格并为其分配事件的需要。它运作良好

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

以下代码将我的原始程序附加到这个

Private Sub abcbutton_Click()
   MsgBox "Testing "
End Sub

并因此给它一个点击事件。
如何在我的程序完成后删除附加的部分。现在当我运行我的程序时
第二次，它已经有方法 abcbutton_Click() 并且它抛出了一个错误。

谢谢
原文来源: http://www.mrexcel.com/archive/VBA/5348a.html

Answer 1

我认为你需要做的是确保按钮只添加一次。

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

此外，您的子创建中有一个错字:

Proc = Proc & "End If" & LF

应该

Proc = Proc & "End Sub" & LF

使用删除代码的方法更新

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