vba 创建一个命令按钮并在程序中为其分配事件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/8251445/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Create a command button and assign event to it in a program
提问by Ank
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.
并因此给它一个点击事件。如何在我的程序完成后删除附加部分。现在当我第二次运行我的程序时，它已经有方法 abcbutton_Click() 并且它抛出一个错误。
Thanks Original Source : http://www.mrexcel.com/archive/VBA/5348a.html
回答by competent_tech
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
