Excel VBA - 使用分配的代码动态创建按钮

Question

我正在尝试动态创建一些按钮，并为它们分配代码。

以下代码有效

Dim MyR As Range, MyB As OLEObject
Dim MyR_T As Long, MyR_L As Long

    Set MyR = Cells(i + 1, 11) 'just an example - you get that from your own script
    MyR_T = MyR.Top         'capture positions
    MyR_L = MyR.Left        '...
    'create button
    Set MyB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False)

    'set main button properties
    With MyB
        .Name = "MyPrecodedButton"     'important - code must exist ... see below
        .Object.Caption = "MyCaption"
        .Top = MyR_T
        .Left = MyR_L
        .Width = 50
        .Height = 18
        .Placement = xlMoveAndSize
        .PrintObject = True            'or false as per your taste

    End With

它在我的循环中创建按钮。但是，我想为单击时分配一些内容，因此我使用以下代码

Dim MyR As Range, MyB As OLEObject
Dim MyR_T As Long, MyR_L As Long

    Set MyR = Cells(i + 1, 11) 'just an example - you get that from your own script
    MyR_T = MyR.Top         'capture positions
    MyR_L = MyR.Left        '...
    'create button
    Set MyB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False)

    'set main button properties
    With MyB
        .OnAction = "interpHere"
        .Name = "MyPrecodedButton"     'important - code must exist ... see below
        .Object.Caption = "MyCaption"
        .Top = MyR_T
        .Left = MyR_L
        .Width = 50
        .Height = 18
        .Placement = xlMoveAndSize
        .PrintObject = True            'or false as per your taste

    End With
    Sub interpHere()
        MsgBox "hi"
    End Sub

我基本上已经添加了.OnAction = "interpHere">，但是当我运行它时，我收到一个错误，无法设置 onaction 属性。

我哪里出错了？

Answer 1

试试这段代码

Sub CreateButtons()
  Dim btn As Button
  ActiveSheet.Buttons.Delete
  Dim t As Range
  For i = 2 To 6 Step 2
    Set t = ActiveSheet.Cells(i, 3)
    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
    With btn
      .OnAction = "interpHere"
      .Caption = "Btn " & i
      .Name = "Btn" & i
    End With
  Next i
End Sub
Sub interpHere()
    MsgBox "hi"
End Sub