如何使用vba创建一个ActiveX按钮并向其添加代码(告诉它运行什么子)？

Question

我想在工作表中创建一个ActiveX按钮并为其分配代码(即告诉它要运行哪个子节点,并且该子节点已经存在).

我可以创建按钮:(已录制)

ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
    , DisplayAsIcon:=False, Left:=41395.5882352941, Top:=234.705882352941, _
    Width:=119.117647058824, Height:=39.7058823529412).Select

但我想更改标题并为其分配一个子标题,以便当有人单击新创建的activex按钮时,它会运行一个已经存在于工作簿中要创建按钮的模块中的子文件.一切都在ThisWorkbook中发生并存在.

谢谢!

PS - 我不能使用命令按钮....我只能使用ActiveX

Answer 1

这有效:

Sub AddingButtons()

Dim btn As Button
Dim t As Range
Dim Obj As Object
Dim Code As String

Dim ShtNm As String
With ThisWorkbook
    .Worksheets.Add(After:=Worksheets(1)).Name = "My New Worksheet"
    .Sheets("My New Worksheet").Activate
End With

ShtNm = ActiveSheet.Name
Sheets(ShtNm).Select

Set t = ActiveSheet.Range("D3:F4")

'create button
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
       Link:=False, DisplayAsIcon:=False, Left:=t.Left, Top:=t.Top, Width:=t.Width, Height:=t.Height)

'button text
ActiveSheet.OLEObjects(1).Object.Caption = "Show Data Selection Window"

'macro text
Code = "Private Sub CommandButton1_Click()" & vbCrLf
Code = Code & "Call MyTestSub(ShtNm)" & vbCrLf
Code = Code & "End Sub"

MsgBox "Worksheet name is " & ActiveSheet.Name
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(Worksheets(ShtNm).CodeName).CodeModule
    .insertlines .CountOfLines + 1, Code
End With

End Sub

改编自:http: //social.msdn.microsoft.com/Forums/office/en-US/1a48cdfd-42af-486c-a4a5-3d5d5797d00c/adding-an-active-x-command-button-and-its-code -使用功能于Excel的VBA？论坛= exceldev

PS - 蒂姆 - 在我对原始问题的评论中得到了答案.谢谢你. 如何在Excel中创建动态按钮