Question

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

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

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

示例：

用户使用滚动条向下滚动ListBox，然后双击“Test 100”项目
列表框已更新，但选择不正确。选择“测试86”，其位于前一个选择“测试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

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

UF模块：

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 2

使用

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 3

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

Answer 4

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

Programatic ListBox选择选择了错误的项目

4 个答案: