Public Sub convertToValueList(theListBox As Access.ListBox)
'First column must be the PK
Dim rs As DAO.Recordset
Dim strSql As String
Dim fldField As DAO.Field
Dim strLstValue As String
Dim intColCount As Integer
Dim intColCounter As Integer
Dim intRowCounter As Integer
If theListBox.RowSourceType = "Table/Query" Then
intColCount = theListBox.ColumnCount
strSql = theListBox.RowSource
theListBox.RowSource = ""
Set rs = CurrentDb.OpenRecordset(strSql)
theListBox.RowSourceType = "Value List"
Do While Not rs.EOF
For intColCounter = 0 To intColCount - 1
strLstValue = strLstValue & """" & CStr(Nz(rs.Fields(intColCounter), " ")) & """;"
Next intColCounter
intRowCounter = intRowCounter + 1
rs.MoveNext
strLstValue = Left(strLstValue, Len(strLstValue) - 1)
theListBox.AddItem (strLstValue)
strLstValue = ""
Loop
End If
End Sub
Public Sub lstMoveUp(lstList As Access.ListBox)
Dim itmIndex As Long
Dim strItem As String
itmIndex = lstList.ListIndex
If itmIndex < 0 Then
MsgBox "Select an item in the list"
ElseIf itmIndex = 0 Then
MsgBox "Beginning of List"
Else
strItem = getListString(lstList, itmIndex)
lstList.RemoveItem itmIndex
lstList.AddItem strItem, (itmIndex - 1)
End If
End Sub
Public Sub lstMoveDown(lstList As Access.ListBox)
Dim itmIndex As Long
Dim strItem As String
itmIndex = lstList.ListIndex
If itmIndex < 0 Then
MsgBox "Select an Item in the List"
ElseIf itmIndex >= lstList.ListCount - 1 Then
MsgBox "End of List"
Else
strItem = getListString(lstList, itmIndex)
lstList.RemoveItem itmIndex
lstList.AddItem strItem, (itmIndex + 1)
End If
End Sub
Public Function getListString(lstList As Access.ListBox, itmIndex As Long) As String
Dim columnCounter As Integer
For columnCounter = 0 To lstList.ColumnCount - 1
getListString = getListString & lstList.Column(columnCounter, itmIndex) & ";"
Next columnCounter
getListString = Left(getListString, Len(getListString) - 1)
Debug.Print getListString
End Function
Public Sub sortFromLstBox(lstList As Access.ListBox, strSql As String, PKname As String, RankField As String)
'First column has PK
Dim rs As DAO.Recordset
Dim PK As Variant
Dim itmIndex As Integer
Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
For itmIndex = 0 To lstList.ListCount - 1
PK = lstList.Column(0, itmIndex)
rs.FindFirst PKname & " = " & PK
rs.Edit
rs.Fields(RankField) = itmIndex + 1
rs.Update
Next itmIndex
End Sub