我在工作簿中有一个按钮(wbShared),点击该按钮会打开第二个工作簿(wbNewUnshared)。我想以编程方式向代码添加wbNewUnshared按钮。 我已经找到了如何添加按钮,但我还没有找到如何在此按钮中添加代码。
'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
编辑: 解决了 好的,给出的代码有效,我有一个错误'程序访问Visual Basic项目不受信任'。感谢S Meaden的帮助,我通过https://support.winshuttle.com/s/article/Error-Programmatic-Access-To-Visual-Basic-Project-Is-Not-Trusted解决了这个问题。 之后我的代码工作了。再次感谢。
答案 0 :(得分:0)
我提供的第一个代码假定为1个工作簿。我现在提供的代码没有。这种情况的限制是,如果arrBttns
丢失,项目将被重置,代码和按钮之间的链接将丢失,并且必须再次运行过程addCodeToButtons
。
在 wbNewUnshared 中,使用以下代码创建一个类模块
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 中添加一个包含以下代码的标准模块
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
模块中添加以下代码,这是将代码添加到工作簿打开的按钮上。
Option Explicit
Private Sub Workbook_Open()
Call addCodeToButtons
End Sub
在 wbShared 中添加按钮后添加以下行
Application.Run "wbNewUnshared.xlsm!addCodeToButtons"
将类模块添加到您添加的项目中。
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