Excel VBA +如何以编程方式向按钮添加代码

Question

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"

I found this online:

'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

But this gives an error in the last line. Anybody has a clue? tx

EDIT: SOLVED Ok, 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.

Answer 1

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.

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

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

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

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

To a module you add the code below

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