未触发VBA ComboBox更改事件

时间:2018-11-29 15:20:21

标签: excel vba class events combobox

我在ComboBox事件处理程序中遇到此问题。

我设法创建了(并填充了项目)我想要的组合框,代码似乎运行正常。但是,在程序运行之后,如果我尝试在一个组合框中选择一个常规项目,似乎_Change方法没有被调用->我无法处理更改事件。

这是我的课程模块(课程名称:“ DB_ComboBox”)

    Option Explicit

    Public WithEvents DB_ComboBoxEvents As MSForms.ComboBox
    Private DB_ComboBox_Line As Integer

    Private Sub DB_ComboBoxEvents_Change()
        MsgBox ("Line : " & DB_ComboBox_Line)
        'Here I want handle The comboboxes changes
        'But this routine is not called!

    End Sub

    Sub Box(CBox As MSForms.ComboBox)
        Set DB_ComboBoxEvents = CBox
    End Sub


    Public Property Let Line(value As Integer)
        DB_ComboBox_Line = value
    End Property

    Public Property Get Line() As Integer
        Line = DB_ComboBox_Line
    End Property

这是我的“主模块”,在其中创建组合框,并将其传递给“ DB_ComboBox”的集合。

        Sub CreateComboBox(IncCBoxes)

        Dim curCombo As MSForms.ComboBox
        Dim rng As Range
        Dim tot_items As Integer
        Dim incAddItem As Integer
        Dim incAddItemBis As Integer
        Dim itemBaseArray() As String
        Dim TEMP_ComboBoxInst As New DB_ComboBox


        Set rng = ActiveSheet.Range("J" & IncCBoxes)

        Set curCombo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height).Object



         'Add the items
        itemBaseArray = Split(Foglio7.Cells(IncCBoxes, DBColFileComboIndexErrori), ";")

        For incAddItem = 0 To UBound(itemBaseArray)

            Dim itemLastArray() As String
            itemLastArray = Split(itemBaseArray(incAddItem), ",")

            For incAddItemBis = 0 To UBound(itemLastArray)
                curCombo.AddItem (itemLastArray(incAddItemBis))
            Next

        Next


        TEMP_ComboBoxInst.Box curCombo
        TEMP_ComboBoxInst.Line = IncCBoxes
        customBoxColl.Add TEMP_ComboBoxInst


    End Sub

谁能告诉我我想念的东西吗?

非常感谢您

2 个答案:

答案 0 :(得分:0)

这看起来像是时间问题: 在另一个打开的文件中运行此代码将起作用。在同一文件中没有。 将对类的添加与OLEControl的添加分开,即: 立即使用Application.ontime

请参见下面的代码:

Private customBoxColl As New Collection

Sub CreateComboBox(IncCBoxes As Long)

        Dim curCombo As MSForms.ComboBox
        Dim rng As Range
        Dim tot_items As Integer
        Dim incAddItem As Integer
        Dim incAddItemBis As Integer
        Dim itemBaseArray() As String
        Dim itemLastArray() As String

        Set rng = ActiveSheet.Range("J" & IncCBoxes)

        With ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)
            Set curCombo = .Object
        End With

         'Add the items
        itemBaseArray = Split(Foglio7.Cells(IncCBoxes, DBColFileComboIndexErrori), ";")
        For incAddItem = 0 To UBound(itemBaseArray)
            itemLastArray = Split(itemBaseArray(incAddItem), ",")
            For incAddItemBis = 0 To UBound(itemLastArray)
               curCombo.AddItem (itemLastArray(incAddItemBis))
            Next
        Next
    Application.OnTime Now, "'CallToClass """ & curCombo.Name & """,""" & IncCBoxes & "'"
End Sub

Sub CalltoClass(ctl As String, myline As Long)
Dim TEMP_ComboBoxInst As New DB_ComboBox
        TEMP_ComboBoxInst.Box ActiveSheet.OLEObjects(ctl).Object
        TEMP_ComboBoxInst.line = myline
        customBoxColl.Add TEMP_ComboBoxInst
End Sub

答案 1 :(得分:0)

我知道这不适用于您的特定问题,但是我会在这里将其发布给其他可能遇到此问题的人。就我而言,事件停止触发,因为我刚刚将数据库复制到了新的Github存储库中。

在重新打开Access时,事件在前一天还不错时并没有触发,这完全让我感到难过,特别是因为没有SO答案似乎可以解决我的问题。基本上,Access会阻止宏和代码,并要求通过单击屏幕顶部的黄色小警告上的“确定”来重新启用宏。