问题描述
我在工作簿(wbShared)中有一个按钮，单击该按钮会打开第二个工作簿(wbNewUnshared).我想以编程方式向代码中的wbNewUnshared添加一个按钮.我已经找到了如何添加按钮，但是没有找到如何向该按钮添加代码.
I have a button in a workdbook (wbShared), clicking on that button a second workbook (wbNewUnshared) opens. I want to add a button to wbNewUnshared with code programmatically.I already found how to add the button, but I didn't find how to add code to this button.
'create button
'--------------------------------------------------------
Dim objBtn As Object
Dim ws As Worksheet
Dim celLeft As Integer
Dim celTop As Integer
Dim celWidth As Integer
Dim celHeight As Integer
Set ws = wbNewUnshared.Sheets("Sheet1")
celLeft = ws.Range("S3").left
celTop = ws.Range("T2").top
celWidth = ws.Range("S2:T2").width
celHeight = ws.Range("S2:S3").height
Set objBtn = ws.OLEObjects.add(classType:="Forms.CommandButton.1", link:=False, _
displayasicon:=False, left:=celLeft, top:=celTop, width:=celWidth, height:=celHeight)
objBtn.name = "Save"
'buttonn text
ws.OLEObjects(1).Object.Caption = "Save"
我在网上找到了这个
'macro text
' Code = "Sub ButtonTest_Click()" & vbCrLf
' Code = Code & "Call Tester" & vbCrLf
' Code = Code & "End Sub"
' 'add macro at the end of the sheet module
' With wbNewUnshared.VBProject.VBComponents(ActiveSheet.name).codeModule
' .InsertLines .CountOfLines + 1, Code
' End With
但是这在最后一行给出了错误.有人有线索吗?tx
But this gives an error in the last line. Anybody has a clue?tx
解决了好的，给出的代码有效，我遇到了错误无法信任对Visual Basic项目的编程访问".感谢S Meaden的帮助，我通过 https://support.winshuttle.com/s/article/Error-Programmatic-Access-To-Visual-Basic-Project-Is-Not-Trusted .之后，我的代码工作了.所以再次感谢.
SOLVEDOk, the code given works, I had an error 'Programmatic Access To Visual Basic Project Is Not Trusted'. Thanks to the help of S Meaden I solved that via https://support.winshuttle.com/s/article/Error-Programmatic-Access-To-Visual-Basic-Project-Is-Not-Trusted.after that my code worked. So thanks again.
推荐答案
我提供的第一个代码假设有一个工作簿.我现在呈现的代码没有.这样做的局限性在于，如果 arrBttns 丢失，则将重置项目，代码和按钮之间的链接也会丢失，并且必须再次运行 addCodeToButtons 过程
The first code I provided assumes 1 workbook. The code I'm presenting now does not. The limitation of this is that if the arrBttns is lost, the project is reset, the link between the code and the button is lost and the procedure addCodeToButtons has to be run again.
在 wbNewUnshared 中，使用以下代码创建一个类模块
In the wbNewUnshared, create a class module with the following code
Option Explicit
Public WithEvents cmdButtonSave As MSForms.CommandButton
Public WithEvents cmdButtonDoStuff As MSForms.CommandButton
Private Sub cmdButtonDoStuff_Click()
'Your code to execut on "Do Stuff" button click goes here
MsgBox "You've just clicked the Do Stuff button"
End Sub
Private Sub cmdButtonSave_Click()
'Your code to execut on "Save" button click goes here
MsgBox "You've just clicked the Save button"
End Sub
在 wbNewUnshared 中添加具有以下代码的标准模块
In the wbNewUnshared add a standard module with the following code
Option Explicit
Dim arrBttns() As New Class1
Public Sub addCodeToButtons()
Dim bttn As OLEObject
Dim ws As Worksheet
Dim i As Long
ReDim arrBttns(0)
'Iterate through worksheets
For Each ws In ThisWorkbook.Worksheets
'Iterate through buttons on worksheet
For Each bttn In ws.OLEObjects
'Expand arrBttns for valid buttons.
If bttn.Name = "Save" Or bttn.Name = "DoStuff" Then
If UBound(arrBttns) = 0 Then
ReDim arrBttns(1 To 1)
Else
ReDim Preserve arrBttns(1 To UBound(arrBttns) + 1)
End If
End If
'Link button to correct code
Select Case bttn.Name
Case "Save"
Set arrBttns(UBound(arrBttns)).cmdButtonSave = bttn.Object
Case "DoStuff"
Set arrBttns(UBound(arrBttns)).cmdButtonDoStuff = bttn.Object
End Select
Next bttn
Next ws
End Sub
在 wbNewUnshared 中的 ThisWorkbook 模块中添加以下代码，这是将代码添加到打开的工作簿中的按钮上.
In the wbNewUnshared add the following code in the ThisWorkbook module, this is to add the code to the buttons on workbook open.
Option Explicit
Private Sub Workbook_Open()
Call addCodeToButtons
End Sub
完成按钮添加后，在 wbShared 中添加以下行
In the wbShared add the following line after you're done adding buttons
Application.Run "wbNewUnshared.xlsm!addCodeToButtons"
原始答案
将类模块添加到要添加到您的项目中.
Original Answer
Add a class module to your project to which you add.
Option Explicit
Public WithEvents cmdButton As MSForms.CommandButton 'cmdButton can be an name you like, if changed be sure to also change the Private Sub below
Private Sub cmdButton_Click()
'Your code on button click goes here
MsgBox "You just clicked me!"
End Sub
向模块中添加以下代码
Option Explicit
Dim arrBttns() As New Class1 'Change Class1 to the actual name of your classmodule
'The sub which adds a button
Sub addButton()
Dim bttn As OLEObject
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set bttn = ws.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
ReDim arrBttns(0)
If UBound(arrBttns) = 0 Then
ReDim arrBttns(1 To 1)
Else
ReDim Preserve arrBttns(1 To UBound(arrBttns))
End If
Set arrBttns(UBound(arrBttns)).cmdBttn = bttn.Object
End Sub
这篇关于Excel VBA +如何以编程方式向按钮添加代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！