编程列表框选择选择了错误的项目

Question

我正在构建一个 Excel VBA 项目，该项目使用 ListBox 在树结构中导航。通过双击一个项目，它会在下面展开其他项目。我的目标是，通过进行此选择，将进行更改并且 ListBox 将更新，同时保留用户刚刚单击的选择并将其保留在视图中。

我创建了一个单独的工作簿来隔离问题，我必须让它变得更简单，并且我将能够将任何解决方案复制到我的原始项目中。

我的 ListBox 是使用 RowSource 填充的。值存储在工作表上（出于真正的原因，我将在这篇文章中省略以保持重点），对工作表进行更改，然后再次调用 RowSource 以更新 ListBox。通过这样做，ListBox 将更新，然后跳到视图中最后一项所做的选择，但现在选择的列表项是在先前选择的位置不正确的项。

---

例子：

1. 用户使用滚动条向下滚动 ListBox 并双击项目“Test 100”
2. ListBox 已更新，但选择不正确。 'Test 86' 被选中，它位于前一个选择'Test 100' 的位置，它被放置在视图的底部。

Here's a download link for the example workbook

---

我希望有人能够提出一个优雅的解决方案来纠正这种行为！

我已尝试在 RowSource 更新后以编程方式进行选择，但这没有效果。通过添加一个短暂的暂停并调用 DoEvents （在示例中注释），我已经能够在一定程度上完成这项工作，但是我发现它并不是一直都有效，我不想强​​制执行暂停，因为它使 ListBox 在我的原始项目中感觉反应迟钝。

Private selection As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    selection = ListBox1.ListIndex
    Call update
End Sub

Private Sub UserForm_Initialize()

    Call update

End Sub

Sub update()
With Sheets("Test")
    ListBox1.RowSource = .Range("A2:A" & .Range("A99999").End(xlUp).Row - 1).Address(, , , True)
End With

'Sleep 300
'DoEvents

ListBox1.ListIndex = selection

End Sub

Answer 1

使用

Private selection As Variant '<~~ use a Variant to store the ListBox current Value
'...

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    selection = ListBox1.Value '<~~ store the ListBox current Value
    Call update '<~~ this will change the ListBox "RowSource"
    ListBox1.Value = selection '<~~ get back the stored ListBox value selected before 'update' call
End Sub

Answer 2

因为这是一个时间问题，我认为解决方案需要延迟或计时器。这不是一个非常优雅的解决方法，但似乎在我有限的测试中有效：

超滤模块：

Option Explicit

Private selection             As Integer

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                                    ByVal lpClassName As String, _
                                    ByVal lpWindowName As String _
                                  ) As Long
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    selection = ListBox1.ListIndex
    Call update
End Sub

Private Sub UserForm_Initialize()

    Call update

End Sub

Sub update()
    Dim hwndUF                As Long
    With Sheets("Test")
        ListBox1.RowSource = .Range("A2:A" & .Range("A99999").End(xlUp).Row - 1).Address(, , , True)
    End With
    If selection <> 0 Then
        hwndUF = FindWindow("ThunderDFrame", Me.Caption)
        UpdateListIndex hwndUF
    End If
End Sub
Public Sub UpdateLBSelection()
    ListBox1.ListIndex = selection
End Sub

然后在普通模块中：

Option Explicit
Private Declare Function SetTimer Lib "user32" ( _
                          ByVal hWnd As Long, ByVal nIDEvent As Long, _
                          ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" ( _
                           ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Private hWndTimer As Long
Sub UpdateListIndex(hWnd As Long)
    Dim lRet As Long
    hWndTimer = hWnd
    LockWindowUpdate hWndTimer
    lRet = SetTimer(hWndTimer, 0, 100, AddressOf TimerProc)

End Sub
Public Function TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                          ByVal idEvent As Long, ByVal dwTime As Long) As Long

   On Error Resume Next
   KillTimer hWndTimer, idEvent
   UserForm1.UpdateLBSelection
   LockWindowUpdate 0&
   Userform1.Repaint
End Function

Answer 3

我知道这已经过时了，但几个月前我遇到了同样的问题，只是偶然发现了未在列表框中选择正确项目的解决方案（解决我的问题）。 事实证明，工作表的缩放级别导致了准确性问题。在某些缩放级别时，列表框有时看起来有点模糊 - 也许这只是我 - 无论如何，解决方案只是放大/缩小一个不会导致问题的点。 谢谢 回复

Answer 4

我也遇到了这个问题，在设置 ListBox 选择之前简单添加 Userform.Repaint 就可以了......