Ms Access multi-select 列表框移动器

Question

我有两个列表框（lfmVocabulary 和 lfmVocabularyAssign）。它们都与表单没有绑定，我在实现代码设计的某些方面时遇到了麻烦。

到目前为止，我能够通过查询记录集用值填充第一个列表表单，但我无法将项目从一个框转移到另一个框。

为了实现这一点，我将代码放在一个模块中，如下所示

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

在表单中，我有以下代码：

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

总的来说，我对访问和编码有点陌生，我一直在网上搜索解决方案。

我会向任何可以帮助我的人表示感谢:D

Answer 1

您犯了多个小错误并且没有考虑到一些复杂性，这是正确的代码：

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

复杂性包括：从列表框中删除项目会取消选择所有项目，因此您应该将所选项目存储在集合中。此外，您需要以相反的顺序删除项目，因为删除一个项目会更改每个具有更高索引的项目的索引（数字）。

Answer 2

在 MS Access 表单中（与 Excel 的用户表单不同），您可以直接将查询分配给 ListBox.RowSource 而无需遍历记录集：

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

要更新值，请使用上一个列表框的选定项目传递动态查询：

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

Ms Access multi-select 列表框移动器

Ms Access multi-select listbox mover

database

ms-access

vba

ms-access-2016