MS Access多选列表移动器v2

时间:2017-07-10 17:56:11

标签: database vba ms-access access-vba ms-access-2016

作为上面列出的上一篇文章的扩展名:

Ms Access multi-select listbox mover

我在这里得到了一些社区成员的大力帮助(向@Parfait寻求他的继续帮助和@Erik Von Asmuth)关于我在编写多选列表移动器时遇到的问题。

第一个问题已经解决,但是,我在cmdRemove_Click()按钮的执行中遇到了新问题。问题如下:

我有两个列表框(lfmVocabulary和lfmVocabularyAssign)。第一个列表框(lfmVocabulary)具有多选功能,用于选择要分配给单元的词汇单词,从而转移到lfmVocabularyAssign列表框中。我可以选择并传输.selected而没有任何问题(感谢社区),现在我有一个问题,将它们从lfmVocabularyAssign列表框发送回lfmVocabulary。

说我有词汇A,B和C.我选择A& B要转移,点击cmdAdd并没有问题。但如果我选择A& B并点击cmdRemove将它们传回第一个列表框,C代替A& B在第二个列表框中!

这是我的代码:

Option Compare Database


Private Sub cmdAdd_Click()

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 VocabSpeechDefID IN (" & in_clause & ")"

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

End Sub

Private Sub cmdClearAll1_Click()

 Dim n As Integer

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

End Sub

Private Sub cmdClearAll2_Click()

 Dim n As Integer

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

End Sub

Private Sub cmdRemove_Click()

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.lfmVocabularyAssign
    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 VocabSpeechDefID NOT IN (" & in_clause & ")"

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

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 cmdSelectAll2_Click()
 Dim n As Integer

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

Private Sub cmdAssign_Click()

:(

End Sub

Private Sub Form_Load()

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

End Sub 

1 个答案:

答案 0 :(得分:1)

嗯,你在这里遇到了一个明显的问题,因为@Parfait他对你的初始问题的解决方案使得来回移动项目变得更加困难,因为它们是使用查询引入的。我假设他的解决方案项目没有从第一个列表中删除,只添加到第二个。如果是这样,这应该有效:

Private Sub cmdRemove_Click()

Dim in_clause As String: in_clause = ""
Dim strSQL As String, n As Integer
'Set the SQL to the current SQL
strSQL = Me.lfmVocabularyAssign.RowSource


' ITERATE TO REMOVE ITEMS FROM COMMA-SEPARATED LIST FOR SQL IN() CLAUSE
With Me.lfmVocabularyAssign
    For n = 0 To .ListCount - 1
       If .Selected(n) = True Then
           If InStr(1, strSQL, ", " & .ItemData(n) ) <> 0 Then
                'Not the first item, nor the only item
                strSQL = Replace(strSQL, ", " & .ItemData(n), "")
           ElseIf InStr(1, strSQL, .ItemData(n) & ", " ) <> 0 Then
                'It's the first item
                strSQL = Replace(strSQL, .ItemData(n) & ", ", "")
            Else
                'It's the only item
                strSQL = Replace(strSQL, .ItemData(n), "")
            End If
       End If
    Next n
End With


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

End Sub