Excel VBA - ActiveX 列表框行为 - 正在清除选择

Excel VBA - ActiveX Listbox Behavior - Selections being cleared

我正在尝试找出一对 ActiveX Multi-select 列表框的问题。

  1. 这些列表框在不同的 sheet 上,但我将它们设置为在鼠标松开时在两者之间同步值。
  2. 这些调用一个函数来同步两者,然后更新一个单元格以保留 select 离子。
  3. 因为写入 sheet 导致 Excel 计算,所以我必须恢复这些 select 离子。

出于某种原因,除了我从 "Summary" sheet.

上的第二个框中 运行 外,一切似乎都正常

简而言之,运行使用调试器的断点为第二个框设置 MouseUp 事件代码。只需在没有断点的情况下触发事件,一切都会正常进行,但一两秒后,select 离子就会清除。

我可以确认重新 运行 恢复 select 离子的代码将从那时起正常工作。此时所有其他行为都按预期工作。只有当 MouseUp 事件被触发时(没有断点),它似乎会导致一些清除 select 离子的事件。 (我现在相信这是重新启用事件后的 sheet 计算......虽然我认为这也会发生在调试中......)


更新 1: 我发现了一个与 sheet 相关的解决方法,即在设置 [=21= 后计算存储 select 离子的位置] 为真。因此,我插入了 Sheet(...).Calculate ,如下所示,现在一切正常。这种行为看起来很奇怪,所以我想看看是否有其他人遇到过这样的事情。为什么 sheet 即使在禁用事件时进行了更改,也会重新计算?出于某种原因,暂时禁用计算似乎也不起作用,尽管我没有花太多时间来测试这个想法(它似乎产生的问题多于它修复的问题)。


更新及解决方案:

这个问题和我最初想的不一样。我发现它与同步无关,实际上与列表框位于不同 sheet 上的事实有关。两者都指的是动态范围(我忘了说),这实际上与动态范围如何重新计算(从而重置列表框)有关。最初当我有一个盒子时,我通过不将命名范围传递给盒子来解决这个问题,而是每次由于导入数据(或使用就地控件进行调整)而更新范围的地址。

这个框与动态范围在同一页上,而另一个不在同一页上,这意味着我无法传递地址(ActiveX 控件不接受 "Linked Cell" 中的 sheet 引用), 所以我决定引用命名范围。这重新引入了我所看到的问题,在这个问题出现之前,我的许多解决方法都处理了其他症状。

我能够通过创建另一个 "stagnant" 命名范围来解决这个问题,当我的其他宏更新它时,我将更新引用以指向原始命名范围,从而阻止它重新计算(并重置我的列表框)。希望这对某人有帮助。


box1: LegSections2Check

Private Sub LegSections2Check_MouseUp(ByVal Button As Integer, _ 
                     ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Call SyncChoices(Sheets("Loads"))
    Retain_Selections SetUp:=True
    Retain_Selections SetUp:=False
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

box2: LegSections2Check2

Private Sub LegSections2Check2_MouseUp(ByVal Button As Integer, _ 
                     ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Call SyncChoices(Sheets("Summary"))
    Retain_Selections SetUp:=True

    'Sheets("Loads").Calculate     '*** This seems to resolve the issue, although _
                                   ' I can't seem to resolve it by setting_ 
                                   ' Application.Calculation to manual in the functions _
                                   ' (this actually broke more things, haha)   

    Retain_Selections SetUp:=False
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

SyncChoices(检测哪个 sheet 编辑框打开并更新另一个框):

Sub SyncChoices(ByVal mySheet As Worksheet)
Dim i As Integer
    If mySheet.Name = "Loads" Then
        With ActiveWorkbook.Sheets("Loads").LegSections2Check
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    ActiveWorkbook.Sheets("Summary").LegSections2Check2.Selected(i) = True
                ElseIf Not .Selected(i) Then
                    ActiveWorkbook.Sheets("Summary").LegSections2Check2.Selected(i) = False
                End If
            Next
        End With
    ElseIf mySheet.Name = "Summary" Then
        With ActiveWorkbook.Sheets("Summary").LegSections2Check2
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    ActiveWorkbook.Sheets("Loads").LegSections2Check.Selected(i) = True
                ElseIf Not .Selected(i) Then
                    ActiveWorkbook.Sheets("Loads").LegSections2Check.Selected(i) = False
                End If
            Next
        End With
    End If
End Sub

Retain_Selections函数:

Sub Retain_Selections(ByVal SetUp As Boolean)
'Dim myListBox As ListBox
Dim i As Integer
Dim MyVals As String
Dim Selections() As String
Dim offset As Integer
Dim myCount As Integer

    With ActiveWorkbook.Sheets("Loads").LegSections2Check
        RefColumn = ActiveWorkbook.Sheets("Loads").Range("RefCol").Column
        If SetUp Then
            ActiveWorkbook.Sheets("Loads").Cells(2, RefColumn).Value = GetSelections()
        Else
            Selections = Split(ActiveWorkbook.Sheets("Loads").Cells(2, RefColumn).Value, ", ")
            ClearSelectedSections
            myCount = .ListCount
            ActiveWorkbook.Sheets("Summary").LegSections2Check2.ListFillRange = "LegsSections"
            If UBound(Selections) > 0 Then If Selections(UBound(Selections)) * 1 > myCount - 1 Then offset = 1: ExtraRow = True
            For i = 0 To UBound(Selections) - offset
                .Selected(Selections(i)) = True
                ActiveWorkbook.Sheets("Summary").LegSections2Check2.Selected(Selections(i)) = True
            Next i
        End If
    End With

和 GetSelections() 函数:

Function GetSelections()
Dim i As Integer
Dim MyVals As String
With ActiveWorkbook.Sheets("Loads").LegSections2Check
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            If MyVals = "" Then
                MyVals = i
            Else
                MyVals = MyVals & ", " & i
            End If
        End If
    Next i
End With
GetSelections = MyVals
End Function

以及 sheets' WorkSheet_Activate 的代码:

"Loads"

Private Sub Worksheet_Activate()
    Retain_Selections Setup:=False
End Sub

"Summary"

Sub Worksheet_Activate()
    Retain_Selections Setup:=False
End Sub

禁用事件时不会关闭自动计算。 Excel 引用一个单独的workbook-global 属性 来判断工作簿是否需要重新计算。所以你必须disable/enable自己自动计算。

所以,两件事:

除了暂时禁用事件之外,我的 "standard" 实用程序函数还可以选择将 AutoCalc 设置为手动 Application.Calculation = xlManual,只是为了确保我的所有宏在允许计算之前完成。

此外,如果您的列表框在不同的 sheet 上,则没有理由重新填充非活动 sheet 上的列表框,直到用户使 sheet 处于活动状态.在这种情况下,当用户选择 sheet.

时,我会在每个 sheet 上使用 Worksheet_Activate() 事件来填充列表框

第二件事的推论:如果您的代码依赖列表框中的项目列表作为部分代码中使用的 "the" 过滤器,请考虑创建一个命名范围作为将填充每个列表框的数据.此方法意味着您只更新作品中的单元格范围sheet 并且列表框在激活时自动选择它。