Scrolling to show selected item in list box

[grahamj]

I have an unbound multiselect list box.
I redisplay records from a table, and have a little routine to highlight the items previously selected in the list box.
However, there are twenty items in my list and I only have room to show four at a time. So the first selected row is often not visible.
What VBA command do I use to scroll the list box to show the first selected row, please?

 

[VicRauch]

If you know the index number of the first item selected, and that number is, for example, in the variable named "i", you can use this command:

  Forms!YourFormName!YourListBoxName.ListIndex = (i)

Of course you will need to change YourFormName to the name of your form, and change YourListBoxName to the name of your list box.
HTH,

 

[grahamj]

Thanks, Vic.
Setting the ListIndex is what I needed to know.

But I've mucked it up somehow.
I get the message
"You've used the ListIndex property incorrectly".

My listbox is called lstGroup. It is unbound, multiselect Simple, with a RowSource of
SELECT tCode.CodeID, tCode.Description FROM tCode WHERE tCode.CodeType="Group" ORDER BY tCode.Sequence, tCode.Description;
I store the result in txtGroup in the format
;3;7;15;

(I know, not normalized. But at the moment it seems the most practical method for this job.)

I then redisplay with this:

Private Sub Form_Current()

On Error GoTo Form_Current_Err

  Dim r As Long
  Dim i As Long
  i = -1
  If Not IsNull(txtGroup) Then
    For r = 0 To lstGroup.ListCount - 1
      If InStr(txtGroup, ";" & lstGroup.Column(0, r) & ";") Then
        lstGroup.Selected(r) = True
        If i = -1 Then i = r
      Else
        lstGroup.Selected(r) = False
      End If
    Next r
  Else
    For r = 0 To lstGroup.ListCount - 1
      lstGroup.Selected(r) = False
    Next r
  End If
  If i > -1 Then lstGroup.ListIndex = i

Form_Current_Exit:
  Exit Sub

Form_Current_Err:
  MsgBox Error$
  Resume Form_Current_Exit

End Sub

It reselects the values beautifully but gives me the message.
Any idea why I'd get the error?
Thanks

 

[VicRauch]

I played with this quite a bit and can not figure out a way to get it to go to the first entry and keep all of them selected. Sorry.

Hope someone else will take a look at this and be able to help some way.

 

[grahamj]

Thanks very much for your efforts, Vic.

 

[grahamj]

It seems to me that this just might be a case where SendKeys is acceptable.

  If i > -1 Then
    lstGroup.SetFocus
    SendKeys "^{home}{down " & i & "}", True
    txtEmpName.SetFocus
  End If

But the sendkeys instruction doesn't appear to be followed on my computer.
I'm using Access 2000.
Am I likely to have a setting that suppresses such instructions?

 

[VicRauch]

And if SendKeys in this case worked, then the first item selected would be the only item selected after this command was completed. As SendKeys works it's way down the list box, each item it touches would be selected until the next item below it was selected. What you have done here is sent the "cursor" to the top of the list box, then arrowed down "i" times. Each time you arrow down, the item is selected until you arrow down to the next item, then it is selected.

 

[grahamj]

Well, not quite.
I was trying to emulate what pressing the keys manually does.
My listbox is multiselect Simple, not Extended.
When I arrow down the list it just moves the focus, but does not change any selections. If I press the space bar I get a row selected or deselected.
So I was just trying to put the cursor on top of the first row selected.

Should the SendKeys normally work in such a situation?

 

[Andrew Fergus]

Hi

This can be done using an API call like this:

Add this code to the top of your VBA module:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetFocus Lib "user32" () As Long

Private Const WM_VSCROLL = &H115
Private Const SB_THUMBPOSITION = 4

Add this code as a separate function within the same module:

Function MakeDWord(loword As Integer, hiword As Integer) As Long
    MakeDWord = (hiword * &H10000) Or (loword And &HFFFF&)
End Function

And change this code :

  Else
    For r = 0 To lstGroup.ListCount - 1
      lstGroup.Selected(r) = False
    Next r
  End If
  If i > -1 Then lstGroup.ListIndex = i

to this:

  Else
    For r = 0 To lstGroup.ListCount - 1
      lstGroup.Selected(r) = False
    Next r
    i = 0
  End If

Me.lstGroup.SetFocus
hWndSB = GetFocus
LngThumb = MakeDWord(SB_THUMBPOSITION, CInt(i))
lngRet = SendMessage(hWndSB, WM_VSCROLL, LngThumb, 0&)

HTH, Andrew

 

[grahamj]

Thanks, Andrew.
I think I understand what the API is trying to do, even if I don't have a clue how it intends to do it.

I've done all that. The SendMessage gives a return of 0, but my listbox does not scroll.

What do I need to do to troubleshoot it?