Getting values from a VBA Listbox

Hi guys,

In an Access 2007 database, I have a form with a ListBox that grabs the values from one of my tables. I want, when I click on a ListBox item, the value I have selected in the list to appear in a TextBox.

I can't seem to find the right code to do. I've tried many combinations, such as something like the following:

Code:

---

txtS.Value = lstS.ItemData(lstS.ItemsSelected.Item(0))

---

I've a feeling it must be easy and I can't see the wood for the trees. Should be a simple query, but I've waded through the VBA API and after working in Java it all seems much more vague and hazy.

Thanks for your help,

Leggie

Sorry, just tried finding the answer for you. Then I realised/remembered how much I HATE Access 2007. I'm going out instead. I had ended up with something similar to what you had posted, but my event handler appeared to be the wrong one becuase I was getting an error becuase the list had no items selected! If you are still stuck tomorrow then I'll sort the code out to do it in Access 2 instead.

(Access 2 is the version of Access that I used during the Access developer stage of my programming career.)

I've had no more luck, I'm afraid, so any help would be gratefully received, thanks.

I'm also somewhat glad to see that it isn't just me that has trouble with Access!

Thanks,

Leggie

I've no idea, but an educated guess would be:

Code:

---

txtS.Value = lstS.ItemsSelected.Item(0).Value

---

Good lord the Access 2007 help is appalling, isn't it. I've never been able to find anything in office help since 2002...

Anyway, the code you are looking for is

Code:

---

txtS.Value = lstS.Value

---

the value of the listbox is the value of the bound column in the currently selected row (at the risk of guessing, if you have a multiselect list with more than 1 item selected you probably get a comma-separated list of the selected items). If you have a multi-column listbox and want to use a value other than the bound column (although why you'd do that is beyond me ;) ) you'd need

Code:

---

txtS.Value = lstS.List(lstS.ListIndex, columnindex)

---

where columnindex is the zero-based index of the column you're interested in. That example only works for non-multiselect lists though: for multiselects you'd need something like

Code:

---

Dim result as String, i as Integer

For i = 0 to lstS.ListCount - 1
    If lstS.Selected(i) result = result & lstS.List(i, columnindex) & ", "
Next i

txtS.Value = result

---

But that's probably enough showing off from me for tonight ;)

Quote:

---

Originally Posted by scaryjim

If you have a multi-column listbox and want to use a value other than the bound column (although why you'd do that is beyond me ;) ) you'd need

Code:

---

txtS.Value = lstS.List(lstS.ListIndex, columnindex)

---

where columnindex is the zero-based index of the column you're interested in.

But that's probably enough showing off from me for tonight ;)

---

Hi,

Thanks for this - I finally managed to work out the problem, and using your code have been able to retrieve the value of the bound column.

The other issue I have is that I also need to get the value of one of the non-bound columns. The second piece of code you suggest would seem to do that; unfortunately, there doesn't appear to be a List method in ListBox. Were you thinking of another method?

Thanks again,

Leggie

EDIT: It seems that this will do the trick:

Code:

---

lstS.Column(2, lstS.RowSource)

---

Thanks again!

Here by one class to get column nr , column name , value of a cel from a List box
also you can moving the mouse redim the columns .
The behavior is the same like a GridView in .Net


' Create the class
Option Compare Database
Dim InitialListColWdt As Integer
Dim InitialColsWidts As String
Public InitPosX As Integer
Public ValuelistBoxMouseDown As Integer
Public ValuelistBoxMouseMove As String
Public CurrentScrollPosValue As Integer
Public SumColsWdtValue As Integer
Private ValueStrColsWdt As String
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 Declare Function apiGetScrollInfo _
Lib "user32" Alias "GetScrollInfo" (ByVal hWnd As Long, _
ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long

Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
' Scroll Bar Commands
Private Const SB_THUMBPOSITION = 4
' Code end for General Declarations
''''Dim hwnd As Long
''''hWnd = ListBox1.[_GethWnd]

Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
Private Declare Function apiGetFocus Lib "user32" _
Alias "GetFocus" _
() As Long
Private myscrollinfo As SCROLLINFO
Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_DISABLENOSCROLL = &H8
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)
Private Const SB_HORZ = 0
Private Const SB_CTL = 2
Private Const SB_VERT = 1
' Here's the MakeDWord function from the MS KB
'********************04/04/2014*******************
Public Function MakeDWord(hiword As Integer) As Long
MakeDWord = (hiword * &H10000) Or (SB_THUMBPOSITION And &HFFFF&)
'*****************04/04/2014**********************************
End Function
Public Function PubGetFocus() As Long
PubGetFocus = GetFocus
End Function

Public Function PubSendMessage(ByVal InhWndSB As Long, ByVal InLngThumb As Long) As Long
PubSendMessage = SendMessage(InhWndSB, WM_HSCROLL, InLngThumb, 0&)
End Function



Public Function fhWnd(ctl As Control) As Long
On Error Resume Next
ctl.SetFocus
If Err Then
fhWnd = 0
Else
fhWnd = apiGetFocus
End If
On Error GoTo 0
End Function
Public Function GetCurrentScrollPos(ListHwnd As Long) As Long
'This function receives the ListBox as ctl and
'returns the current value of the ScrollBar
'This function will be called while the ListBox has
'the Focus.
'Dim myscrollinfo As SCROLLINFO
Dim lngRet As Long
Dim lngListHwnd As Long
Dim lngMask As Long
myscrollinfo.cbSize = LenB(myscrollinfo)
myscrollinfo.fMask = SIF_ALL
'lngListhwnd = fhWnd(ctl)
If ListHwnd = 0 Then GoTo MyErr
lngRet = apiGetScrollInfo(ListHwnd, SB_HORZ, myscrollinfo)
CurrentScrollPosValue = myscrollinfo.nPos
'If CurrentScrollPosValue > 0 Then
Dim SplLstWidt() As String
SplLstWidt = Split(StrColsWdt, ";")
SumColsWdtValue = 0
For c = 0 To CurrentScrollPosValue

SumColsWdtValue = SumColsWdtValue + SplLstWidt(c)
Next c
'End If

GetCurrentScrollPos = myscrollinfo.nPos
ResumeErr:
Exit Function
MyErr:
End Function


Public Property Get StrColsWdt() As String
StrColsWdt = ValueStrColsWdt
End Property
Public Property Let StrColsWdt(Value As String)
If Value <> NullString Then
ValueStrColsWdt = Value
End If
End Property



Public Function listBoxMouseDown(X As Single, Y As Single, ByRef OutInitialPosX As Integer, ByRef OutInitiallistColWidth As Integer) As Integer
'InitialColsWidts = ColsWidts
InitPosX = X
InitPosY = Y
ValueStrColsWdt = ValueStrColsWdt
SumColsWdtValue = SumColsWdtValue
InitPosX = InitPosX '+ SumColsWdtValue
Dim colWidth As Variant
Dim pos As Integer
Dim SplLstWidt() As String
SplLstWidt = Split(StrColsWdt, ";")
'Dim Max As Integer
' For c = 0 To lstToebehoren.ColumnCount - 2
' Max = Max + SplLstWidt(c)
'Next c
For c = CurrentScrollPosValue To UBound(SplLstWidt) - 1
colWidth = SplLstWidt(c)
pos = pos + CInt(colWidth)
If pos > InitPosX Then
OutInitialPosX = pos
OutListColNr = c
Exit For
End If
Next c
ValuelistBoxMouseDown = OutListColNr
listBoxMouseDown = OutListColNr
OutInitiallistColWidth = SplLstWidt(OutListColNr)
InitialListColWdt = OutInitiallistColWidth
If ((pos - 80 < InitPosX And pos + 80 > InitPosX) Or pos = InitPosX) And InitPosY < 200 Then
Screen.MousePointer = 3
End If

End Function

Public Function listBoxMouseMove(Button As Integer, X As Single, Y As Single) As String
If Button = vbKeyLButton Then
Dim SizeX As Integer
Dim JoinSplLstWidt As String
SizeX = CInt(InitialListColWdt) + (X - InitPosX)
'Show3.Value = SizeX
Dim SplLstWidt() As String
If CInt(SizeX) > 0 Then
If Screen.MousePointer = 3 Then
SplLstWidt = Split(StrColsWdt, ";")
SplLstWidt(ValuelistBoxMouseDown) = CInt(SizeX)
JoinSplLstWidt = Join(SplLstWidt, ";")
ValuelistBoxMouseMove = JoinSplLstWidt
listBoxMouseMove = JoinSplLstWidt
Else
ValuelistBoxMouseMove = StrColsWdt
listBoxMouseMove = StrColsWdt
End If
'Show.Value = JoinSplLstWidt

End If

End If
End Function


Public Function listBoxMouseUp()
'lstToebehorenColsWdt = Show.Value
'If ValuelistBoxMouseMove <> vbNullString Then
StrColsWdt = ValuelistBoxMouseMove
'End If
Screen.MousePointer = 1
'Show.Value = lstToebehorenColsWdt
End Function
Public Sub restoreArrow()
If Screen.MousePointer = 3 Then
Screen.MousePointer = 1
End If
End Sub

Public Sub MoveListBoxScroll()
Dim hWndSB As Long
Dim lngRet As Long
Dim lngIndex As Long
Dim LngThumb As Long

' You will get lngIndex value from the user or whatever.
' For now I'm just setting it to arbitrary Number
lngIndex = CurrentScrollPosValue

' SetFocus to our listBox so that we can
' get its hWnd

hWndSB = PubGetFocus 'GetFocus

' Set the window's ScrollBar position
LngThumb = MakeDWord(CInt(lngIndex))
lngRet = PubSendMessage(hWndSB, LngThumb) 'SendMessage(hWndSB, WM_HS
End Sub


'Add the metodes

in Load Form set the initial width of the columns


LBG.StrColsWdt = "800;0;1200;1200;2500;1200;1000;800;800;500;500;400;400;400;700;900;900;0;0;0;0;0;600;900;900;900;90 0;900;900;900;1000;400;900;900;300"


'*********************************************
Create one Type to get the values X,Y in the event mouse down


Public Type MouseObjectPosition
X As Long
Y As Long

End Type

Public MOP As MouseObjectPosition


'************************************************

'in the event Double click of the listBox

Private Sub lstTarificatie_DblClick(Cancel As Integer)



If Me.lstTarificatie.ListIndex > -1 Then

ClipBoard_SetData Trim(Me.lstTarificatie.Column(CopyCell(MOP.X, MOP.Y), Me.lstTarificatie.ListIndex + 1))

End If


End Sub

'**************************************************


'In the event Mouse Down of the ListBox

Private Sub lstTarificatie_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MOP.X = X
MOP.Y = Y
If Y < 200 Then
'************************Scroll************************
Dim OutInitialPosition As Integer
Dim OutInitiallistColWidth As Integer
Dim OutColName As String
Dim CurrentScrollPos As Integer
'*******Scroll**Position****
Dim GetfhWndValue As Long
GetfhWndValue = LBG.fhWnd(lstTarificatie)
CurrentScrollPos = LBG.GetCurrentScrollPos(GetfhWndValue)
'***************************

'**********Class**************
Dim OutColNr As Integer
OutColNr = LBG.listBoxMouseDown(X, Y, OutInitialPosition, OutInitiallistColWidth)
OutColName = lstTarificatie.Column(OutColNr, 0)
'*********************************************************
End If

In Mouse Move


Private Sub lstTarificatie_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

'*********************Scroll*************************
If X < 20 Or X > Me.lstTarificatie.Width - 20 Or Y < 20 Or Y > Me.lstTarificatie.Height - 20 Then
LBG.restoreArrow
End If
If Button = vbKeyLButton Then
Dim NewWidths As String
NewWidths = LBG.listBoxMouseMove(Button, X, Y)

End If
'*****************************************************
End Sub

'****************************************************************
'In Mouse Up

Private Sub lstTarificatie_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'04/04/2014
If Screen.MousePointer = 3 Then
lstTarificatie.ColumnWidths = LBG.ValuelistBoxMouseMove
LBG.listBoxMouseUp
Screen.MousePointer = 1
DoEvents
'Customer_Click
Me.lstTarificatie.SetFocus
LBG.MoveListBoxScroll

End If
End Sub