excel vba +プログラムでボタンにコードを追加する方法

Question

ワークブック（wbShared）にボタンがあり、そのボタンをクリックすると2番目のワークブック（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

EDIT： は [OK]を、コード与えられた作品を解決し、私はエラー「のVisual Basicプロジェクトへのプログラムによるアクセスは信頼されていません」でした。 S Meadenの助けを借りて私はhttps://support.winshuttle.com/s/article/Error-Programmatic-Access-To-Visual-Basic-Project-Is-Not-Trustedでそれを解決しました。その後、私のコードが働いた 。もう一度ありがとう。

Answer 1

私が提供した最初のコードは、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 

はあなたが追加するプロジェクトにクラスモジュールを追加追加ボタン

Application.Run "wbNewUnshared.xlsm!addCodeToButtons" 

---

オリジナル回答

を終わった後は、次の行を追加しますwbShared 。モジュールに

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