Excel VBA - ActiveX 列表框行为 - 正在清除选择
Excel VBA - ActiveX Listbox Behavior - Selections being cleared
我正在尝试找出一对 ActiveX Multi-select 列表框的问题。
- 这些列表框在不同的 sheet 上,但我将它们设置为在鼠标松开时在两者之间同步值。
- 这些调用一个函数来同步两者,然后更新一个单元格以保留 select 离子。
- 因为写入 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 并且列表框在激活时自动选择它。
我正在尝试找出一对 ActiveX Multi-select 列表框的问题。
- 这些列表框在不同的 sheet 上,但我将它们设置为在鼠标松开时在两者之间同步值。
- 这些调用一个函数来同步两者,然后更新一个单元格以保留 select 离子。
- 因为写入 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 并且列表框在激活时自动选择它。