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

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