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

Question

Я хотел бы добавить элемент управления и связанное событие во время выполнения в 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

Answer 1

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

Создайте пользовательскую форму и введите следующий код:

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

---

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

---

Public WithEvents butEvents As MSForms.CommandButton

Private Sub butEvents_click()

    MsgBox "Hi Shrey"

End Sub

---

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

Answer 2

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

Я использовал его для массива переключателей (поместите изображение «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

Answer 3

Попробуйте это:

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. Затем вы можете удалить форму, как только закончите.

Чип Пирсон имеет отличную информацию о кодировании VBE.

Answer 4

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

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

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

Answer 5

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

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

With UserForm1.CodeModule
  'Insert code here
End With

Вместо ваших With ThisWorkbook

Answer 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

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