Как добавить события в элементы управления, созданные во время выполнения в Excel с помощью VBA

Я хотел бы добавить элемент управления и связанное с ним событие во время выполнения в Excel с помощью VBA, но я не знаю, как добавить события.

Я попробовал код ниже, и кнопка была правильно создана в моей пользовательской форме, но связанное событие клика, которое должно отображать приветственное сообщение, не работает.

Любые советы/исправления будут приветствоваться.

Dim Butn As CommandButton
Set Butn = UserForm1.Controls.Add("Forms.CommandButton.1")
With Butn
    .Name = "CommandButton1"
    .Caption = "Click me to get the Hello Message"
    .Width = 100
    .Top = 10
End With

With ThisWorkbook.VBProject.VBComponents("UserForm1.CommandButton1").CodeModule
    Line = .CountOfLines
    .InsertLines Line + 1, "Sub CommandButton1_Click()"
    .InsertLines Line + 2, "MsgBox ""Hello!"""
    .InsertLines Line + 3, "End Sub"
End With
UserForm1.Show

ОТВЕТЫ

Ответ 1

Код добавления кнопки во время выполнения, а затем для добавления событий поистине прост, так как это трудно понять. Я могу сказать, что, поскольку я потратил больше времени на это недоумение и получил раздражение больше, чем во что-либо иначе я бы запрограммировал..

Создайте Userform и введите следующий код:

Option Explicit


Dim ButArray() As New Class2

Private Sub UserForm_Initialize()
    Dim ctlbut As MSForms.CommandButton

    Dim butTop As Long, i As Long

    '~~> Decide on the .Top for the 1st TextBox
    butTop = 30

    For i = 1 To 10
        Set ctlbut = Me.Controls.Add("Forms.CommandButton.1", "butTest" & i)

        '~~> Define the TextBox .Top and the .Left property here
        ctlbut.Top = butTop: ctlbut.Left = 50
        ctlbut.Caption = Cells(i, 7).Value
        '~~> Increment the .Top for the next TextBox
        butTop = butTop + 20

        ReDim Preserve ButArray(1 To i)
        Set ButArray(i).butEvents = ctlbut
    Next
End Sub

Теперь U нужно добавить модуль класса в ваш код для проекта.. Пожалуйста, помните его модуль класса, а не Module.And введите следующий простой код (в моем случае имя класса - Class2) -

Public WithEvents butEvents As MSForms.CommandButton

Private Sub butEvents_click()

    MsgBox "Hi Shrey"

End Sub

Вот оно. Теперь запустите его

Ответ 2

Попробуйте следующее:

Sub AddButtonAndShow()

    Dim Butn As CommandButton
    Dim Line As Long
    Dim objForm As Object

    Set objForm = ThisWorkbook.VBProject.VBComponents("UserForm1")

    Set Butn = objForm.Designer.Controls.Add("Forms.CommandButton.1")
    With Butn
        .Name = "CommandButton1"
        .Caption = "Click me to get the Hello Message"
        .Width = 100
        .Top = 10
    End With

    With objForm.CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub CommandButton1_Click()"
        .InsertLines Line + 2, "MsgBox ""Hello!"""
        .InsertLines Line + 3, "End Sub"
    End With

    VBA.UserForms.Add(objForm.Name).Show

End Sub

Это постоянно изменяет UserForm1 (при условии сохранения вашей книги). Если вам нужна временная пользовательская форма, добавьте новую пользовательскую форму, а не установите ее в UserForm1. Затем вы можете удалить форму, как только вы закончите с ней.

Chip Pearson содержит отличную информацию о кодировании VBE.

Ответ 3

DaveShaw, спасибо для этого человека кода!

Я использовал его для массива togglebutton (поместите изображение "thumbnail-size" под названием trainer.jpg в ту же папку, что и файл excel для переключателя с изображением в нем). В событии 'click' также доступен invoker (по имени объекта в виде строки)

В форме:

Dim CreateTrainerToggleButtonArray() As New ToggleButtonClass 

Private Sub CreateTrainerToggleButton(top As Integer, id As Integer)

Dim pathToPicture As String
pathToPicture = ThisWorkbook.Path & "\trainer.jpg"
Dim idString As String
idString = "TrainerToggleButton" & id

Dim cCont As MSForms.ToggleButton
Set cCont = Me.Controls.Add _
   ("Forms.ToggleButton.1")

With cCont
   .Name = idString
   .Width = 20
   .Height = 20
   .Left = 6
   .top = top
   .picture = LoadPicture(pathToPicture)
   End With

   ReDim Preserve CreateTrainerToggleButtonArray(1 To id)
   Set CreateTrainerToggleButtonArray(id).ToggleButtonEvents = cCont
   CreateTrainerToggleButtonArray(id).ObjectName = idString

   End Sub

и класс "ToggleButtonClass" 

  Public WithEvents ToggleButtonEvents As MSForms.ToggleButton
  Public ObjectName As String


  Private Sub ToggleButtonEvents_click()
  MsgBox "DaveShaw is the man... <3 from your friend: " & ObjectName
  End Sub

Теперь просто простой вызов из UserForm_Initialize

 Private Sub UserForm_Initialize()
   Dim index As Integer
   For index = 1 To 10
     Call CreateTrainerToggleButton(100 + (25 * index), index)
   Next index
 End Sub

Ответ 4

Это было мое решение добавить командную строку и код без использования классов Он добавляет ссылку, чтобы разрешить доступ к vbide Добавляет кнопку

Затем записывает функцию для обработки события click на листе

Sub AddButton()
Call addref
Set rng = DestSh.Range("B" & x + 3)
'Set btn = DestSh.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=rng.Left, Top:=rng.Top, Height:=rng.Height * 3, Width:=rng.Width * 3)
DoEvents
With myButton
     '.Placement = XlPlacement.xlFreeFloating
     .Object.Caption = "Export"
     .Name = "BtnExport"

     .Object.PicturePosition = 1
     .Object.Font.Size = 14
   End With
   Stop
   myButton.Object.Picture = LoadPicture("F:\Finalised reports\Templates\Macros\evolution48.bmp")

Call CreateButtonEvent

End Sub

Sub addref()
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"

End Sub


    Private Sub CreateButtonEvent()
On Error GoTo errtrap

    Dim oXl As Application: Set oXl = Application
    oXl.EnableEvents = False
    oXl.DisplayAlerts = False
    oXl.ScreenUpdating = False
    oXl.VBE.MainWindow.Visible = False

    Dim oWs As Worksheet
    Dim oVBproj As VBIDE.VBProject
    Dim oVBcomp As VBIDE.VBComponent
    Dim oVBmod As VBIDE.CodeModule '
    Dim lLine As Single
    Const QUOTE As String = """"

    Set oWs = Sheets("Contingency")
    Set oVBproj = ThisWorkbook.VBProject
    Set oVBcomp = oVBproj.VBComponents(oWs.CodeName)
    Set oVBmod = oVBcomp.CodeModule

    With oVBmod
        lLine = .CreateEventProc("Click", "BtnExport") + 1
        .InsertLines lLine, "Call CSVFile"
    End With

    oXl.EnableEvents = True
    oXl.DisplayAlerts = True
Exit Sub
errtrap:


End Sub

Ответ 5

Я думаю, что код должен быть добавлен в Userform, а не в самой кнопке.

Так что-то вроде

With UserForm1.CodeModule
  'Insert code here
End With

Вместо вашего With ThisWorkbook

Ответ 6

Простой способ сделать это:

1 - Вставьте модуль класса и напишите этот код:

Public WithEvents ChkEvents As MSForms.CommandButton
Private Sub ChkEvents_click()
MsgBox ("Click Event")
End Sub

2 - Вставьте форму пользователя и напишите этот код:

Dim Chk As New Clase1
Private Sub UserForm_Initialize()
Dim NewCheck As MSForms.CommandButton
Set NewCheck = Me.Controls.Add("Forms.CommandButton.1")
NewCheck.Caption = "Prueba"
Set Chk.ChkEvents = NewCheck
End Sub

Теперь покажите форму и нажмите кнопку