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

我对Access和编码有点新意，我一直在寻找解决方案。

我会向能帮助我的人致以诚挚的谢意：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多选列表框移动器

2 个答案: