MS Access 多选列表移动器 v2

Posted 2023-05-07

【中文标题】MS Access 多选列表移动器 v2

【英文标题】：MS Access multi-select list mover v2

【发布时间】：2017-07-10 17:56:11

【问题描述】：

作为对下面列出的上一篇文章的扩展：

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】：

好吧，您在这里遇到了一个明显的问题，因为@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

【讨论】：

埃里克·冯·阿斯穆斯，感谢您的回复。你永远是第一个，非常感谢！你是对的，他们没有从第一个列表中删除。它们在 cmdAdd_Click() 事件之后仍然存在。然而，词汇被转移到第二个列表。我将您的代码插入到 cmdRemove_Click() 函数中，但它返回编译错误：代码中突出显示 strSQL = Replace(strSQL, .ItemData(n) & ", "), "") 的语法错误。 :(

哦，对不起，现在修好了。正在尝试 VS Code，它会自动添加括号，所以我有一个太多了。 （编辑：现在真的修复了，仍然习惯了那些额外的括号。编辑编辑：到处都是括号！删除了一些）

还是同样的错误。编译错误：strSQL = Replace(strSQL, .ItemData(n) & ", "), "")

抱歉，Erik，但现在 cmdRemove_Click() 不起作用，每次加载表单时，都会加载第二个列表框中的词汇，而不是重新分配给第一个列表框

仔细检查@Parfait 的代码，列表也不会在表单加载时重新分配