创build一个命令button并在程序中为其分配事件

我在网上发现了这个代码，稍微调整了一下，因为我需要以编程方式向电子表格添加一个命令button，并为其分配一个事件。 它运作良好

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

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

 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