Question

我有以下代码动态创建按钮：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, sInfo As String


    For i = 2 To GetLastRow("Deliverables", "A")

    sInfo = "CmdButton" & i

    Me.Buttons(sInfo).Delete


    ActiveSheet.Buttons.Add(Cells(i, "AA").Left + Cells(i, "AA").Width * 0.05, Cells(i, "AA").Top + Cells(i, "AA").Height * 0.05, Cells(i, "AA").Width * 0.9, Cells(i, "AA").Height * 0.9).Select
    With Selection
        .Caption = "Update Task: " & Cells(i, "B").Value
        .Name = sInfo
        .Text = "Update Task: " & Cells(i, "B").Value
        Selection.OnAction = "CmdButton2_Click"

    End With
    Next
End Sub

这样运行没有错误，但我似乎无法工作的是Selection.OnAction事件。当我点击按钮时没有任何反应。我试图让OnAction事件调用我的VBA代码中的另一个Sub。我从这里和网上的其他地方尝试了一些例子，似乎无法使它们发挥作用。

任何人都知道我错过了什么？

Answer 1

我能够创建一个按钮，并使用以下代码调用宏例程：

Sub CreateButton()
Dim I, sInfo As String
Dim sBut
    I = 2        
    sInfo = "CmdButton" & I

    ActiveSheet.Buttons(sInfo).Delete

    Set sBut = ActiveSheet.Shapes.AddFormControl(xlButtonControl, _
        Cells(I, "AA").Left + Cells(I, "AA").Width * 0.05, Cells(I, "AA").Top + Cells(I, "AA").Height * 0.05, Cells(I, "AA").Width * 0.9, Cells(I, "AA").Height * 0.9)
    With sBut
        .Name = sInfo
        .OnAction = "MyMacro"
        .TextFrame.Characters.Text = "Update Task: " & Cells(I, "B").Value
    End With
End Sub

Sub MyMacro()
MsgBox "You Clicked Me"
End Sub

Answer 2

适合我

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, sInfo As String, c As Range
Dim rngUpdate As Range, rw As Range, r As Long
Dim tsk As String

    Set rngUpdate = Application.Intersect(Target, Me.Range("C2:G20"))

    If rngUpdate Is Nothing Then Exit Sub

    Set rngUpdate = rngUpdate.EntireRow

    For Each rw In rngUpdate.Rows

        r = rw(1).Row
        sInfo = "CmdButton" & r

        On Error Resume Next
        Me.Buttons(sInfo).Delete
        On Error GoTo 0

        Set c = ActiveSheet.Cells(r, "B")
        With ActiveSheet.Buttons.Add(c.Left + c.Width * 0.05, _
                                c.Top + c.Height * 0.05, _
                                c.Width * 0.9, c.Height * 0.9)

            .Caption = "Update Task: " & Cells(r, "C").Value
            .Name = sInfo
            tsk = Cells(r, "C").Value
            .Text = "Update Task: " & tsk
            .OnAction = "'Sheet1.CmdButton2_Click """ & tsk & """'"

        End With
    Next rw

End Sub

Sub CmdButton2_Click(r)
    Debug.Print "clicked update for : " & r
End Sub

Excel VBA OnAction事件不起作用，但也不会发生错误

2 个答案: