Results 1 to 6 of 6
Like Tree1Likes
  • 1 Post By Kyle123

Programatically Deleting OLEObject ComboBox Click Event Handler Subs

This is a discussion on Programatically Deleting OLEObject ComboBox Click Event Handler Subs within the Excel Questions forums, part of the Question Forums category; Hello everyone! I am dynamically creating a bunch of ActiveX/OLEObject comboboxes. Each combobox needs to have a dynamically created Click ...

  1. #1
    New Member
    Join Date
    Apr 2017
    Location
    Chicagoland, IL
    Posts
    3

    Default Programatically Deleting OLEObject ComboBox Click Event Handler Subs

    Hello everyone!

    I am dynamically creating a bunch of ActiveX/OLEObject comboboxes. Each combobox needs to have a dynamically created Click event handler. I am able to do this, no prob.

    The problem is that, occasionally during a session I want to delete all of the comboboxes and their associated event handlers and recreate them. The addCombos() method below first deletes existing comboboxes, then tries to delete click event handlers before creating new ones.

    I've gotten very close to solving this but the spreadsheet keeps crashing part way through deleting the dynamically created click event handlers. Here's the code, I've got it loaded into "Sheet1":

    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
        
        Application.ScreenUpdating = False
        
        Sheets("Sheet1").Activate
        Set VBProj = ActiveWorkbook.VBProject
        Set vbCodeMod = VBProj.VBComponents(ActiveSheet.CodeName).CodeModule
        
        thisRow = 1
        thisCol = 1
        thisLeft = 0
        thisTop = 0
    
    
        ' nuke any existing comboboxes
        For Each obj In ActiveSheet.OLEObjects
            obj.Delete
        Next obj
        
        ' clear existing dynamically created code procedures
        With vbCodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
        
                If Left(ProcName, 13) = "TestComboBox_" And Right(ProcName, 6) = "_Click" Then
                    StartLine = .ProcStartLine(ProcName, ProcKind)
                    NumLines = .ProcCountLines(ProcName, ProcKind)
                    .DeleteLines StartLine:=StartLine, count:=NumLines
                End If
            Loop
        End With
        
        ' add a few new combo boxes
        For i = 0 To 5
            thisName = "TestComboBox_" + 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,
            ' see:  http://stackoverflow.com/questions/9476481/detecting-event-on-comboboxes-added-at-runtime-on-excel
            vbCodeMod.AddFromString AddEvent(obj.name)
            
            thisRow = thisRow + 1
        Next i
        
    End Sub
    
    
    Private Function AddEvent(strIn As String) As String
        AddEvent = "Public Sub " & strIn & "_Click()" & Chr(10) & _
                        "dim newVal As String" & Chr(10) & _
                        "newVal = ActiveSheet.OLEObjects(""" + strIn + """).Object.value" & Chr(10) & _
                        "MsgBox newVal" & Chr(10) & _
                    "End Sub"
    End Function
    The first time I run addCombos() everything works as planned. Comboboxes are created on Sheet1 and event handler subs are inserted at the top of the module.

    If I run addCombos() again, it starts will successfully delete the first event handler, TestComboBox_5_Click() but then Excel crashes.

    I'm running Excel 2016/64-bit. I have the following VBAProject references set in Tools > References:
    • Visual Basic for Applications
    • Microsoft Excel 16.0 Object Library
    • OLE Automation
    • Microsoft Office 16.0 Object Library
    • Microsoft Forms 2.0 Object library
    • Microsoft Visual Basic for Applications Extensibility 5.3


    Thank you very much for any help in advance. I am at my wit's end on this.

  2. #2
    MrExcel MVP
    Join Date
    May 2006
    Location
    Excel 2003, Australia
    Posts
    8,297

    Default Re: Programatically Deleting OLEObject ComboBox Click Event Handler Subs

    hi

    What about the loop "Do Until LineNum >= .CountOfLines" when within the loop lines are being deleted? This might cause a problem.

    Suggest looping through all the current code lines & creating an array with the replacement lines: no changes to the existing lines en route. Once the new lines are ready, insert all the new lines en masse before deleting any old lines. This approach does work & I recall other ways were problematic. This old code from something in my files demonstrates

    HTH. Regards, Fazza

    Code:
      With MyModule.CodeModule
        
        jLoop = 0
        lLineCountBefore = .CountOfLines
        ReDim asReplacementLines(1 To lLineCountBefore)
        
        For iLoop = 1 To lLineCountBefore
          sOneCodeLine = Trim$(.Lines(iLoop, 1))
          If wanttokeepthisline Then
            jLoop = jLoop + 1
            asReplacementLines(jLoop) = sOneCodeLine
           End If
        Next iLoop
        ReDim Preserve asReplacementLines(1 To jLoop)
        
        Debug.Print "module " & strModuleName & " : take out " & lngLineCountBefore & " line" & IIf(lLineCountBefore <> 1, "s", vbNullString)
        .InsertLines lLineCountBefore + 1, Join$(asReplacementLines, vbCrLf) 'insert replacement code first, then
        .DeleteLines 1, lLineCountBefore 'delete original code afterwards
      End With
    A better question - clearly explained & with sample data (input & corresponding output as appropriate) that can be copied to Excel - will increase the chances of a better answer.

    Please report spam via the 'Report' button at the bottom LHS

  3. #3
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    17,558

    Default Re: Programatically Deleting OLEObject ComboBox Click Event Handler Subs

    Maybe...

    Code:
        With vbCodeMod
            LineNum = .CountOfLines
            Do While LineNum > .CountOfDeclarationLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                NumLines = .ProcCountLines(ProcName, ProcKind)
                If Left(ProcName, 13) = "TestComboBox_" And Right(ProcName, 6) = "_Click" Then
                    .DeleteLines LineNum - NumLines + 1, NumLines
                End If
                LineNum = LineNum - NumLines
            Loop
        End With
    Hope this helps!
    Domenic Tamburino
    Microsoft MVP - Excel
    xl-central.com - "For Your Microsoft Excel Solutions"

  4. #4
    Board Regular Kyle123's Avatar
    Join Date
    Jan 2012
    Location
    Leeds, UK
    Posts
    2,188

    Default Re: Programatically Deleting OLEObject ComboBox Click Event Handler Subs

    Why not just use a class to handle to events?

    It's a lot neater than that approach
    Norie likes this.

  5. #5
    New Member
    Join Date
    Apr 2017
    Location
    Chicagoland, IL
    Posts
    3

    Default Re: Programatically Deleting OLEObject ComboBox Click Event Handler Subs

    @FAZZA & @Dominic, thank you. I will try your suggestions out now and report back.

    @Kyle123, I do have some experience with OOP in other languages but was not sure that you could do such stuff with Excel VBA. It's funny, I just ran across an article yesteraday talking about using the Class Modules. I need to learn more about that feature, will look into this now.

  6. #6
    New Member
    Join Date
    Apr 2017
    Location
    Chicagoland, IL
    Posts
    3

    Default Re: Programatically Deleting OLEObject ComboBox Click Event Handler Subs

    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

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com