Ms Access multi-select listbox mover

问题

I have two list boxes (lfmVocabulary and lfmVocabularyAssign). They are both unbound along with the form and I'm having trouble achieving certain aspects of the code design.

Thus far, I am able to populate the first list form with the values through a query recordset, but I'm unable to transfer the items from one box to the other.

In an attempt to achieve this, I placed the code in a module as follows

Option Compare Database

Public Sub MoveListBoxItems(lfmVocabularyAssign As ListBox, _
lfmVocabulary As ListBox)

Dim intListX As Integer

For intListX = lfmVocabulary.ListCount = -1 To 0
    If lfmVocabulary.Selected(intListX) Then
     lfmVocabularyAssign.AddItem lfmVocabulary.List(intListX)
     lfmVocabulary.RemoveItem intListX
    End If
Next
End Sub

In the form, I have the following code:

Option Explicit

Dim db As Database
Dim rs As Recordset


Private Sub cmdAdd_Click()

MoveListBoxItems lfmVocabulary, lfmVocabularyAssign

End Sub


Private Sub cmdSelectAll1_Click()

    Dim n As Integer

    With Me.lfmVocabulary
        For n = 0 To .ListCount - 1
            .Selected(n) = True
        Next n
    End With

End Sub

Private Sub Form_Load()

    Set db = CurrentDb
    Set rs = db.OpenRecordset("qryVocabularyDefinitions")

    Me.lfmVocabulary.RowSource = ""
    Do Until rs.EOF
        Me.lfmVocabulary.AddItem rs!Vocabulary
        rs.MoveNext
    Loop

End Sub

I am kinda new to Access and coding in general and I've been scouring the Internet looking for a solution.

I would offer a thousand thanks to anyone that can help me :D

回答1:

In MS Access forms (unlike Excel's userforms), you can directly assign a query to a ListBox.RowSource without needing to iterate through a recordset:

Me.lfmVocabulary.RowSource = "qryVocabularyDefinitions"
Me.lfmVocabulary.RowSourceType = "Table/Query"
Me.lfmVocabulary.Requery

And to update the values, pass a dynamic query using the selected items of previous listbox:

Dim in_clause As String: in_clause = ""
Dim strSQL As String, i As Integer

' ITERATE TO BUILD COMMA-SEPARATED LIST FOR SQL IN() CLAUSE
With Me.lfmVocabulary
    For n = 0 To .ListCount - 1
       If .Selected(n) = True Then
           in_clause = in_clause & .ItemData(n) & ", "
       End If
    Next n
End With

' REMOVE LAST COMMA AND SPACE
in_clause = Left(in_clause, Len(in_clause)-2)

strSQL = "SELECT * FROM qryVocabularyDefinitions" _
           & " WHERE ID IN (" & in_clause & ")"

Me.lfmVocabularyAssign.RowSource = strSQL
Me.lfmVocabularyAssign.RowSourceType = "Table/Query"
Me.lfmVocabularyAssign.Requery

回答2:

You've made multiple small errors and not accounted for some complexities, here's the correct code:

Public Sub MoveListBoxItems(lstDestination As ListBox, lstSource As ListBox)
    Dim intListX As Integer
    Dim selectedItems As Collection
    Set selectedItems = New Collection
    For intListX = 0 To lstSource.ListCount - 1 'Start with 0, then iterate through the whole list
        If lstSource.Selected(intListX) Then
            lstDestination.AddItem lstSource.ItemData(intListX) 'Add items first

        End If
    Next intListX 'Increment intListX by 1
    Do While intListX >= 0
        If lstSource.Selected(intListX) Then
            selectedItems.Add intListX 'Add the items to be removed to a collection, in reverse order
        End If
        intListX = intListX - 1
    Loop
    Dim iterator As Variant
    For Each iterator In selectedItems
        lstSource.RemoveItem iterator 'And then remove them
    Next iterator
End Sub

Complexities include: removing an item from a list box deselects all items, so you should store the selected items in a collection. Also, you need to remove items in reverse order, since removing one changes the index (number) for each one with a higher index.

来源：https://stackoverflow.com/questions/44990548/ms-access-multi-select-listbox-mover