Add Controls With Events at Runtime

[llowwelll]

I want to be able to add controls to a VBA worksheet at runtime and the
be able to handle them with events. How do I do this?

Specifically, my application automatically queries a constantl
changing Access database every five minutes. The records from th
query are then displayed on an Excel worksheet. There is one row fo
each record. What I need to do is add a couple of command buttons an
a label to each row/record. If the user clicks on one of the button
or labels added at runtime, I need to be able to respond to this wit
code.

Thanks very much in advance for any help or advice that you ca
provide!

 

[Chip Pearson]

Try code like the following:

Dim OLEObj As OLEObject
Dim Rng As Range
Dim WS As Worksheet
Dim CodeMod As Object
Dim LineNum As Long
Set WS = ActiveSheet
Set Rng = Range("G10")

Set OLEObj =
WS.OLEObjects.Add(classtype:="Forms.CommandButton.1", _
Top:=Rng.Top, Left:=Rng.Left, Height:=Rng.Height * 2,
Width:=Rng.Width * 2)
OLEObj.Name = "MyButton"
OLEObj.Object.Caption = "Click Me"
Set CodeMod =
ThisWorkbook.VBProject.VBComponents(Sheet1.CodeName).CodeModule
LineNum = CodeMod.CreateEventProc("Click", OLEObj.Name)
CodeMod.InsertLines LineNum + 1, _
"Msgbox ""You clicked me"" "


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[llowwelll]

Chip,

That is awesome! Thanks for the reply!!

I tried it and it worked great. I was unaware that code could b
created on the fly.

An additional question for you:
1) How do I programatically delete the procedures that are create
with this code?


Thank you very much again! :

 

[onedaywhen]

llowwelll wrote ...

How do I programatically delete the procedures that are created
with this code?

With this variation, there is no need to:

Option Explicit
Private c As CButton
Sub test()

Dim OLEObj As OLEObject
Dim Rng As Range
Dim WS As Worksheet

Set WS = ActiveSheet
Set Rng = Range("G10")

Set OLEObj = WS.OLEObjects.Add(classtype:="Forms.CommandButton.1", _
Top:=Rng.Top, Left:=Rng.Left, Height:=Rng.Height * 2, Width:=Rng.Width * 2)
OLEObj.Name = "MyButton"
OLEObj.Object.Caption = "Click Me"
Set c = New CButton
c.Init OLEObj.Object
End Sub

'<In class module called CButton>
Option Explicit

Private WithEvents m_Button As MSForms.CommandButton

Public Sub Init(ByVal Button As MSForms.CommandButton)
Set m_Button = Button
End Sub

Private Sub m_Button_Click()
MsgBox "You clicked " & m_Button.Name
End Sub
'</In class module called CButton>

--

 

[FlaviusFlav]

I've also tried some code to copy the recordset to an array, but thi
fails as well.. same error.
Code works fine if the recordset has no missing values



Dim aTable1Values
aTable1Values = rs.GetRows() '<----Dies here now

Dim iRowLoop, iColLoop
For iRowLoop = 0 To UBound(aTable1Values, 2)
For iColLoop = 0 To UBound(aTable1Values, 1)
MsgBox (aTable1Values(iColLoop, iRowLoop))
Next
Next 'iRowLoo

 

[llowwelll]

Okay, I modified Chip Pearson's code that he gave in the reply above t
hopefully do exactly what I need it to do. The code I came up wit
adds the buttons and procedures without a problem. Then, however, whe
it tries to delete the buttons and respective procedures, it onl
deletes every other one. It leaves buttons 2 and 4 every time (alon
with their procedures). I'm pulling my hair out trying to figure i
out. I get the "Method 'OLEObjects' of object '_Worksheet' failed
error message when the procedure tries to run through the delete loo
below.

Please help me on this. Chip, if you're here, I'd love to get you
perspective. Thanks again in advance for the help!!

Sub DeleteAddButtons()

Dim OLEObj As OLEObject
Dim WS As Worksheet
Dim CodeMod As Object, OldBtns, Btn, BtnNum, Size As Integer
Dim BtnName As String
Dim LineNum As Long
Set WS = ActiveSheet
Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim HowManyLines As Long

OldBtns = WS.OLEObjects.Count
Size = Int((6 * Rnd) + 1) 'Randomly Generated Number of_
Buttons
'Delete Controls and Procedures
If OldBtns > 2 Then 'On my sheet I have 2 buttons that_
I want to stay all of the time
For D = 1 To OldBtns
'Assumes that there are other controls on the sheet_
that we dont want to be deleted
BtnName = WS.OLEObjects(D).Name
If Left(BtnName, 6) = "Button" Then
btnnum = Right(BtnName, Len(BtnName) - 6)
'Delete the procedures
Set VBCodeMod = ThisWorkbook.VBProject._
VBComponents("Sheet1").CodeModule
With VBCodeMod
StartLine = .ProcStartLine("Button" &_

BtnNum& "_Click", vbext_pk_Proc)
HowManyLines = .ProcCountLines("Button" &_
BtnNum & "_Click", vbext_pk_Proc)
.DeleteLines StartLine, HowManyLines
End With
'Delete the buttons
Worksheets("sheet1").OLEObjects("Button" &_
BtnNum).Delete
Next D
End If

'Add Controls and Procedures Back to Sheet Based on_
Results of Latest Query
For Btn = 1 To Size
Set OLEObj = WS.OLEObjects.Add_
(classtype:="Forms.CommandButton.1", _
Top:=131 + ((Btn - 1) * 23), Left:=160, Height:=23,_
Width:=40)
OLEObj.Name = "Button" & Btn
OLEObj.Object.Caption = "Info"
Set CodeMod = ThisWorkbook.VBProject.VBComponents_
(Sheet1.CodeName).CodeModule
LineNum = CodeMod.CreateEventProc("Click", OLEObj.Name)
CodeMod.InsertLines LineNum + 1, _
"Msgbox ""You clicked me"" "
Next Btn

End Su

 

[llowwelll]

Just bumping this up a bit

 

[Chip Pearson]

When you delete the buttons, you should delete them in descending
order. E.g.,

For D = OldBtns To 1 Step -1
' delete the button
Next D


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[llowwelll]

Chip,

THANK YOU AGAIN!!! That solved the problem!!!! I don't know how lon
it would've taken me to come across that solution on my own throug
experimentation and a thousand Google searches. I'm going to need som
Rogaine for all of the hair I pulled out! lo

 

[llowwelll]

Okay, that did solve the problem for the code given above (and thank
again for the help). However, when I went to place this code into m
full application, I get the 'Microsoft Excel has encountered an erro
and needs to close' message. This apparently occurs right after th
code for the command button(s) is inserted programatically. When I ru
it, Excel moves focus to the VBE module for Sheet 1 with th
programatically generated code visible. It then hangs up and display
the error message.

Things I have considered as possible causes:
1) Protection...the workbook is not protected (BTW, could the workboo
be programatically unprotected just prior to running this code or mus
it be manually unprotected all of the time?)
2) References/Conflicts...I selected the same references for th
workbook that I used to test the above code as are selected in my ful
application and it ran fine. However, the full application crashes.
Those references are:
a. Visual Basic for Applications
b. Microsoft Excel 9.0 Library
c. OLE Automation
d. Microsoft Office 9.0 Library
e. Microsoft Forms 2.0 Library
f. Microsoft Windows Common Controls 2 6.0 (SP4)
g. Microsoft ActiveX Data Objects (Multidimensional) 2.7 Library
h. Microsoft ActiveX Data Objects 2.5 Library
i. Microsoft Outlook 9.0 Library
j. Microsoft Visual Basic for Applications Extensibility 5.3
3) Open ADO Objects...I set all of the ADO objects to Nothing prior t
the commencement of the code in question
4) An integral part of my application is a procedure that invokes th
Application.OnTime function. This causes the database to be querie
every five minutes. I don't know if this could be the cause nor how t
work around it if it is.

Those are the issues that I considered. I have no idea if I'm barkin
up the wrong tree or not.

That's all I could think of and now I'm back to pulling my hair out.
Chip, or anyone else, I'd really appreciate some insight on this. I a
truly grateful for your help thus far and hope I'm not asking too muc
for just a little more.

Thanks again in advance!

 

[onedaywhen]

llowwelll wrote ...

However, when I went to place this code into my
full application, I get the 'Microsoft Excel has encountered an error
and needs to close' message.

Yeah, I've experienced these issues:

http://groups.google.com/groups?hl=...&selm=OmlatE9aDHA.2412%40TK2MSFTNGP10.phx.gbl

The problem seems to occur when the workbook containing the
dynamically created controls is saved. My experience was such a
workbook could not be subsequently saved without going GPF. To ensure
the controls aren't saved in the workbook, you must trap the
_BeforeSave event, teardown the controls, save the workbook and, if
the workbook is not closing, recreate the controls. Of course you must
also persist all the info to enable you to create the controls in the
_Open event.

Re: Chip Pearson's code. Have you noticed this... in the code below,
run Test1 immediately followed by Test2 and explain why the m_strTest
variable is empty when Test2 is executed:

Option Explicit

Private m_strTest As String

Sub Test1()
m_strTest = "Chip"
ChipsCode
MsgBox m_strTest
End Sub

Sub test2()
MsgBox m_strTest
End Sub

Sub ChipsCode()
Dim OLEObj As OLEObject
Dim Rng As Range
Dim WS As Worksheet
Dim CodeMod As Object
Dim LineNum As Long
Set WS = ActiveSheet
Set Rng = Range("G10")

Set OLEObj = _
WS.OLEObjects.Add(classtype:="Forms.CommandButton.1", _
Top:=Rng.Top, Left:=Rng.Left, Height:=Rng.Height * 2, _
Width:=Rng.Width * 2)
OLEObj.Name = "MyButton"
OLEObj.Object.Caption = "Click Me"
Set CodeMod = _
ThisWorkbook.VBProject.VBComponents(Sheet1.CodeName).CodeModule
LineNum = CodeMod.CreateEventProc("Click", OLEObj.Name)
CodeMod.InsertLines LineNum + 1, _
"Msgbox ""You clicked me"" "
End Sub

I came to the conclusion that programmatically adding controls to a
worksheet at run-time is too high risk for production code. In my most
recent Excel project I reluctantly took the decision to have a
permanent number of controls and dynamically hide the ones I didn't
need. Philosophically unsatisfactory but the correct decision for a
very important customer.

--