Присвоение макроса переменной Commandbutton с помощью Excel VBA

Question

Поэтому я создал макрос, который записывает новый макрос в Sheet1 редактора VBA, а затем создает элемент управления ActiveX CommandButton. Теперь мне нужна кнопка для запуска вновь созданного макроса при нажатии. Кнопка была создана как переменная объекта с именем buttonControl.

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Sheet1")
Set CodeMod = VBComp.CodeModule
    With CodeMod
        .InsertLines 34, "Private Sub cmd_OPEN_FOLDER_Click()"
        .InsertLines 35, "    Dim FolderPath As String"
        .InsertLines 36, "    Dim FinalFolder As String"
        .InsertLines 37, "        FolderPath = ""C:\ExampleFolder1\ExampleFolder2\"""
        .InsertLines 38, "        FinalFolder = ActiveSheet.Range(""N1"").Value & ""\"""
        .InsertLines 39, "    Call Shell(""explorer.exe """""" & FolderPath & FinalFolder & """", vbNormalFocus)"
        .InsertLines 40, "End Sub"

    End With

Dim buttonControl As MSForms.CommandButton

    Set buttonControl = _
        ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
            Link:=False, _
            DisplayAsIcon:=False, _
            Left:=1464, Top:=310, Width:=107.25, Height:=30).Object

    With buttonControl
        .Caption = "OPEN FOLDER"
        .Name = "cmd_OPEN_FOLDER"
        .BackColor = "12713921"
        Selection.OnAction = "cmd_OPEN_FOLDER_Click()" 'assigns the macro

    End With

Теперь у меня есть "Ошибка времени выполнения 438: объект не поддерживает это свойство или метод" на

        Selection.OnAction = "cmd_OPEN_FOLDER_Click()" 'assigns the macro

Когда я заканчиваю VBA из диалогового окна и щелкаю по новой кнопке, она закрутилась для правильного связывания. Как это сделать без сообщения об ошибке?

Answer 1

Это работало нормально для меня. OnAction не для кнопок ActiveX - вы называете sub, чтобы соответствовать имени кнопки плюс "_Click"

Sub tester()

    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Set VBProj = ActiveWorkbook.VBProject
    Set VBComp = VBProj.VBComponents("Sheet1")
    Set CodeMod = VBComp.CodeModule

    With CodeMod
        .InsertLines 34, "Private Sub cmd_OPEN_FOLDER_Click()"
        .InsertLines 34, "Msgbox ""OK"""
        .InsertLines 40, "End Sub"
    End With

    Dim buttonControl 'As MSForms.CommandButton

    Set buttonControl = _
        ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
            Link:=False, _
            DisplayAsIcon:=False, _
            Left:=10, Top:=10, Width:=107.25, Height:=30)

    buttonControl.Name = "cmd_OPEN_FOLDER"
    With buttonControl.Object
        .Caption = "OPEN FOLDER"
        .BackColor = 12713921
    End With
End Sub