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

Question

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

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

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

示例：

用户使用滚动条向下滚动列表框并双击项目'Test 100'
列表框已更新，但选择不正确。 '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

我知道这已经很古老了，但几个月前我遇到了同样的问题，只是偶然发现了没有在列表框中选择正确项目的解决方案（针对我的问题）。结果是 sheet 的缩放级别导致了准确性问题。在某些缩放级别时，列表框有时看起来有点模糊 - 也许只有我 - 无论如何，解决方案只是缩放 in/out 一个不会导致问题的点。谢谢 R

Answer 4

我也运行遇到了这个问题，在设置列表框选择之前简单地添加 Userform.Repaint 就成功了......

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

Programatic ListBox selection is selecting the wrong item

excel

vba

userform

excel-2010