编程列表框select是select错误的项目
我正在构buildExcel VBA项目，该项目使用ListBox来浏览树结构。 通过双击一个项目，它将在下面展开其他项目。 我的目标是通过select这个选项来进行更改，并且更新列表框，同时保留用户点击的select并保持在视图中。
我已经创build了一个单独的工作簿来隔离问题，我必须使其更简单，我将能够复制到我原来的项目的任何解决scheme。
我的列表框被填充使用RowSource。 值存储在一张纸上（由于真正的原因，我会从这篇文章中省略它），对表进行更改，然后再次调用RowSource来更新ListBox。 通过这样做，ListBox将会更新，然后跳转到所select的位置是视图中的最后一个项目，但是现在select的列表项目是前一个select位置中不正确的。
例：
- 用户使用滚动条向下滚动列表框并双击项目“testing100”
- 列表框被更新，但是select不正确。 select“testing86”，它位于视图底部的先前select“testing100”的位置。
这是示例工作簿的下载链接
我希望有人能够照亮一个优雅的解决scheme，以纠正这种行为！
我已经尝试了在RowSource更新之后以编程方式进行select，但是这不起作用。 通过添加一个简短的暂停和调用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 因为这是一个时间问题，我认为解决scheme需要延迟或定时器。 这不是一个非常优雅的解决方法，但似乎在我有限的testing中工作：
用友模块：
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
使用
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
我知道现在这是古老的，但几个月前我也有同样的问题，只是偶然发现了一个解决scheme（对我的问题）没有在列表框中select正确的项目。 事实certificate，表单的缩放级别导致了准确性问题。 在某些缩放级别下，有时候看起来有点模糊的列表框 – 也许就是我自己 – 无论如何，解决scheme只是放大/缩小一个没有引起问题的点。 谢谢R
我也碰到这个问题，并在设置ListBoxselect之前添加一个简单的Userform.Repaint做窍门……