ACC2: How to Create a Multiple-Selection List BoxID: Q121356
|
Advanced: Requires expert coding, interoperability, and multiuser skills.
In a typical list box, you can select only one item at a time. This article
describes how to create a multiple-selection list box in which you can
select more than one item at a time.
NOTE: Microsoft Access version 7.0 has incorporated the MultiSelect
property for list box controls. The MultiSelect property of a list box
specifies whether a user can make multiple selections in a list box and
how the multiple selections can be made.
The following example demonstrates how to create a two-column list box in
Microsoft Access version 2.0. The first column displays an "X" if the row
is selected, or is blank if the row is not selected. The second column
will contain the values that you can select. This article also
demonstrates how to create a semicolon-delimited list of the items
selected in the list box.
This article assumes that you are familiar with Access Basic and with
creating Microsoft Access applications using the programming tools provided
with Microsoft Access. For more information on Access Basic, please refer
to the "Introduction to Programming" manual in Microsoft Access version
1.x, or the "Building Applications" manual in version 2.0.
The following example demonstrates how to create and use a multiple-
selection list box. This example uses user-defined Access Basic functions
to fill the list box.
Option Explicit
Type MultiSelectArray_TYPE
Selected As String ' Holds "X" or "" indicating selection
Display As Variant ' The value to display in the list box
' row. Example: John Smith
Value As Variant ' The value to store for the row
' selection. Example: 535-86-9328 (John's
' SSN)
End Type
Dim MultiSelectArray() As MultiSelectArray_TYPE
Dim MultiSelectRows
' Flag indicating if the list is being updated (new selection)
' or being filled.
Global UpdateMultiSelect
Function MultiSelect (fld As Control, id As Long, Row As _
Long, Col As Long, Code As Integer)
'*******************************************************
' CALLED FROM: The RowSourceType property of a list box.
' EXAMPLE:
' RowSourceType: MultiSelect
'*******************************************************
Dim RetVal: RetVal = Null
Select Case Code
Case LB_INITIALIZE
' Is the list being updated by a new selection?
If UpdateMultiSelect Then
' If so, ignore refilling the list.
UpdateMultiSelect = False
Else
' Otherwise, fill the MultiSelect array.
MultiSelectRows = MultiSelectFillArray()
End If
RetVal = MultiSelectRows
Case LB_OPEN
RetVal = Timer ' Unique ID number for control.
Case LB_GETROWCOUNT
' Return the number of rows in the MultiSelect array.
RetVal = UBound(MultiSelectArray) + 1
Case LB_GETCOLUMNCOUNT
' Return the number of columns to display.
RetVal = 2
Case LB_GETCOLUMNWIDTH
RetVal = -1 ' Use the default width.
Case LB_GETVALUE
Select Case Col
Case 0 ' Selected
RetVal = MultiSelectArray(Row).Selected
Case 1 ' Display
RetVal = MultiSelectArray(Row).Display
End Select
Case LB_END ' End
End Select
MultiSelect = RetVal
End Function
Function MultiSelectUpdate (C As Control)
'********************************************************
' CALLED FROM: The AfterUpdate property of the list box.
' EXAMPLE:
' AfterUpdate: =MultiSelectUpdate([<YourListBoxName>])
'********************************************************
' Update the MultiSelect array selection by toggling
' the "X" in the selected row.
Select Case MultiSelectArray(C).Selected
Case ""
MultiSelectArray(C).Selected = "X"
Case "X"
MultiSelectArray(C).Selected = ""
End Select
' Set the flag indicating an update.
UpdateMultiSelect = True
' Requery the list.
C.Requery
End Function
Function MultiSelectFillArray ()
'**********************************************************
' PURPOSE: Fills the MultiSelect array with a list of
' names from the Employees table.
' CALLED FROM: The MultiSelect() function's initialization
' code to fill the list box array with values.
'**********************************************************
Dim DB As Database
Dim RS As Recordset
Dim i As Integer
Dim RecordCount As Integer
Set DB = DBEngine.Workspaces(0).Databases(0)
Set RS = DB.OpenRecordset("Employees", DB_OPEN_SNAPSHOT)
' Get record count.
RS.MoveLast
RecordCount = RS.RecordCount
RS.MoveFirst
' Resize the MultiSelect array to the number of Employee
' records.
ReDim MultiSelectArray(0 To RecordCount - 1)
' Fill the MultiSelect array by setting:
' Selected to "" (clearing "X").
' Display to [First Name] space [Last Name].
' Value to [Employee ID].
For i = 0 To RecordCount - 1
MultiSelectArray(i).Selected = ""
MultiSelectArray(i).Display = RS![First Name] & " " _
& RS![Last Name]
MultiSelectArray(i).Value = RS![Employee ID]
RS.MoveNext
Next i
' Return the number of rows in the array (RecordCount).
MultiSelectFillArray = RecordCount
End Function
Function MultiSelectFillArray ()
'**********************************************************
' PURPOSE: Fills the MultiSelect array with a list of
' field names from the Employees table.
' CALLED FROM: The MultiSelect() function's initialization
' code to fill the list box array with values.
'**********************************************************
Dim DB As Database
Dim RS As Recordset
Dim i As Integer
Set DB = DBEngine.Workspaces(0).Databases(0)
Set RS = DB.OpenRecordset("Employees", DB_OPEN_SNAPSHOT)
' Resize the MultiSelect array to the number of Employee
' fields.
ReDim MultiSelectArray(0 To RS.Fields.Count - 1)
' Fill the MultiSelect array by setting:
' Selected to "" (clearing "X").
' Display to the name of the field.
' Value to the name of the field.
For i = 0 To RS.Fields.Count - 1
MultiSelectArray(i).Selected = ""
MultiSelectArray(i).Display = RS(i).Name
MultiSelectArray(i).Value = RS(i).Name
Next i
' Return the number of rows in the array (the number of
' fields).
MultiSelectFillArray = RS.Fields.Count
End Function
Name: EmployeeFields
ControlSource: <blank>
RowSourceType: MultiSelect
RowSource: <blank>
ColumnCount: 2
ColumnWidths: 0.15 in.
BoundColumn: 0
Width: 1.6 in
Height: 1.5 in
AfterUpdate: =MultiSelectUpdate([EmployeeFields])
Function MultiSelectSemicolonList ()
Dim i
Dim Result
Result = ""
For i = 0 To UBound(MultiSelectArray)
If MultiSelectArray(i).Selected = "X" Then
Result = Result & MultiSelectArray(i).Display & "; "
End If
Next i
' Remove the last semicolon.
If Result <> "" Then Result = Left(Result, Len(Result) - 1)
MultiSelectSemicolonList = Result
End Function
For more information about using an Access Basic function to fill a list
box, search for "filling list boxes/combo boxes," and then "Filling a List
Box or Combo Box Using an Access Basic Function" using the Microsoft Access
version 2.0 Help menu.
For more information about MultiSelect list boxes in Microsoft Access
version 7.0, search for "MultiSelect Property" using the Microsoft Access
for Windows 95 Help Index.
Additional query words: multiselection
Keywords : kbusage FmrCodeb
Version : 2.0
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: April 7, 1999