Finally got it working. Running addCombos() will dynamically remove any pre-existing, dynamically created _Click() action handlers and replace them with new ones. This uses the VBE .VBProject.VBComponents .CodeModule.AddFromString.AddFromString method to write the new code. It's not the most elegant solution but it works.
Code:
Public Sub addCombos()
Dim thisRow As Integer
Dim thisCol As Integer
Dim thisLeft As Integer
Dim thisTop As Integer
Dim I As Integer
Dim obj As OLEObject
Dim thisName As String
Dim VBProj As Object
Dim vbCodeMod As Object
Dim count As Integer
Dim StartLine As Long
Dim NumLines As Long
Dim LineNum As Long
Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind
Dim bodyLine As Long
Dim existingProcedures As Dictionary
Dim thisExistingProceduresKeys, thisExistingProceduresItems, thisExistingProcedureName As Variant
Dim itemKeys, itemItems, itemElements As Variant
Dim controlNamePrefix As String
Dim keyIndex As Long
Dim thisProcedureFound As Boolean
Dim testSubName As String
Sheets("Sheet1").Activate
Set VBProj = ActiveWorkbook.VBProject
Set vbCodeMod = VBProj.VBComponents(ActiveSheet.CodeName).CodeModule
thisRow = 1
thisCol = 1
thisLeft = 0
thisTop = 0
controlNamePrefix = "TestComboBox_"
' nuke any existing comboboxes
For Each obj In ActiveSheet.OLEObjects
obj.Delete
Next obj
' clear existing dynamically created code procedures
Set existingProcedures = getExistingProcedures("Sheet1", "Sheet1") 'get listing of existing procedures
If existingProcedures.count > 0 Then
thisExistingProceduresKeys = existingProcedures.Keys
thisExistingProceduresItems = existingProcedures.Items
For Each thisExistingProcedureName In thisExistingProceduresKeys
If Left(thisExistingProcedureName, 13) = controlNamePrefix And Right(thisExistingProcedureName, 6) = "_Click" Then
With vbCodeMod
StartLine = .ProcStartLine(thisExistingProcedureName, ProcKind)
NumLines = .ProcCountLines(thisExistingProcedureName, ProcKind)
.DeleteLines StartLine:=StartLine, count:=NumLines
End With
End If
Next
End If
Set existingProcedures = Nothing
' add new combo boxes
For I = 0 To 3
thisName = controlNamePrefix + CStr(I)
Cells(thisRow, thisCol).Select
With Selection
thisLeft = .Left
thisTop = .Top
.RowHeight = 20
End With
Set obj = OLEObjects.Add(ClassType:="Forms.ComboBox.1", DisplayAsIcon:=False, Left:=thisLeft, Top:=thisTop, Width:=100, Height:=17)
With obj
.name = thisName
' now add items to each combobox
With obj.Object
.AddItem "Apple"
.AddItem "Orange"
.AddItem "Blueberry"
.Font.Size = 10
End With
End With
' dynamically add the various trigger events for this control
Set existingProcedures = getExistingProcedures("Sheet1", "Sheet1") 'get listing of existing procedures
thisProcedureFound = False
If existingProcedures.count > 0 Then
thisExistingProceduresKeys = existingProcedures.Keys
thisExistingProceduresItems = existingProcedures.Items
For Each thisExistingProcedureName In thisExistingProceduresKeys
testSubName = thisName + "_Click"
If thisExistingProcedureName = testSubName Then
thisProcedureFound = True
Exit For
End If
Next
End If
If thisProcedureFound = False Then
vbCodeMod.AddFromString ( _
"Public Sub " & obj.name & "_Click()" & Chr(10) & _
Chr(9) + "dim newVal As String" & Chr(10) & _
Chr(9) + "newVal = ActiveSheet.OLEObjects(""" + obj.name + """).Object.value" & Chr(10) & _
Chr(9) + "MsgBox newVal" & Chr(10) & _
"End Sub")
End If
thisRow = thisRow + 1
Set existingProcedures = Nothing
Next I
End Sub
Function getExistingProcedures(ByRef worksheetName As String, ByRef searchModule As String) As Dictionary
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim NumLines As Long
Dim WS As Worksheet
Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind
Dim dictKey As String
Dim dictItem As String
Dim tempDictionary As Dictionary
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(searchModule)
Set CodeMod = VBComp.CodeModule
Set WS = ActiveWorkbook.Worksheets(worksheetName)
Set tempDictionary = New Dictionary
LineNum = CodeMod.CountOfDeclarationLines + 1
Do While LineNum <= CodeMod.CountOfLines
dictKey = ""
dictItem = ""
ProcName = CodeMod.ProcOfLine(LineNum, ProcKind)
LineNum = CodeMod.ProcStartLine(ProcName, ProcKind) + CodeMod.ProcCountLines(ProcName, ProcKind) + 1
dictKey = Trim(ProcName)
dictItem = Trim(LineNum)
tempDictionary.CompareMode = BinaryCompare
tempDictionary.Add Key:=(dictKey), Item:=(dictItem)
Loop
Set getExistingProcedures = tempDictionary
End Function
Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
Select Case ProcKind
Case vbext_pk_Get
ProcKindString = "Property Get"
Case vbext_pk_Let
ProcKindString = "Property Let"
Case vbext_pk_Set
ProcKindString = "Property Set"
Case vbext_pk_Proc
ProcKindString = "Sub Or Function"
Case Else
ProcKindString = "Unknown Type: " & CStr(ProcKind)
End Select
End Function
Thanks: 
Likes: 
Programatically Deleting OLEObject ComboBox Click Event Handler Subs
Reply With Quote
Like this thread? Share it with others