在 Access 2013 中使用 VBA 从列表框中分配选项

Question

我在项目中遇到一些问题，我想知道是否有人能够为我指明正确的方向。

图像应该能够比我描述的更容易解释功能：

很简单，我希望用户能够单击 'Add'，然后双击其中一项专业以将其分配给该 DJ。

当用户单击保存按钮时，需要为他们选择的每个专业创建名为 'tblDJSpecialitiy' 的新行 table。每行都需要包含 'Dj_No' 和专业的主键。

首先，我需要在编辑 DJ 表单上获取专业列表以进行更新以反映用户从所有专业列表中单击的专业。

这是我目前在编辑 DJ 表单上的专业列表的代码：

Public Sub displaySpecialities()
'for the selected member display current loans (including overdue loans)
'and loans which have been returned but for which fines are still outstanding
Dim RstSpecialities As DAO.Recordset
Dim strSQL, strSpecialityInformation As String
Dim strDJNo As String
Dim intNumberOfSpecialities, intIndex As Integer
strDJNo = txt_dj_no.Value
'call the function to clear the list
Call clearLst_Specialities
'create an sql query to find the specialities
strSQL = strSQL & "SELECT tblSpeciality.SpecialityName FROM tblSpeciality INNER JOIN tblDJSpeciality ON tblDJSpeciality.[FKSpecialityNo] = tblSpeciality.[SpecialityNo] WHERE tblDJSpeciality.FKDjNo = '" & strDJNo & "';"
'store the results of the query in the recordset
Set RstSpecialities = dbase.OpenRecordset(strSQL, dbOpenDynaset)
'calculate the number of specialities
If Not RstSpecialities.EOF Then
    RstSpecialities.MoveLast
    intNumberOfSpecialities = RstSpecialities.RecordCount
    RstSpecialities.MoveFirst
End If
'add the details of each speciality to the list box
For intIndex = 0 To intNumberOfSpecialities - 1
    strSpecialityInformation = RstSpecialities("SpecialityName")
    lst_specialities.AddItem (strSpecialityInformation)
    RstSpecialities.MoveNext
Next
'close the recordet
RstSpecialities.Close
End Sub

这是我目前必须在添加表单上填充所有专业列表的代码：

Public Sub displaySpecialities()
    'list all specialities in the system
    Dim RstSpecialities As DAO.Recordset
    Dim strSQL, strSpecialityInformation As String
    Dim intNumberOfSpecialities, intIndex As Integer
    'call the function to clear the list
    Call clearLst_Specialities
    'create an sql query to find the specialities
    strSQL = strSQL & "SELECT tblSpeciality.SpecialityName FROM tblSpeciality  ORDER BY SpecialityName ;"
    'store the results of the query in the recordset
    Set RstSpecialities = dbase.OpenRecordset(strSQL, dbOpenDynaset)
    'calculate the number of specialities
    If Not RstSpecialities.EOF Then
        RstSpecialities.MoveLast
        intNumberOfSpecialities = RstSpecialities.RecordCount
        RstSpecialities.MoveFirst
    End If
    'add the details of each speciality to the list box
    For intIndex = 0 To intNumberOfSpecialities - 1
        strSpecialityInformation = RstSpecialities("SpecialityName")
        lst_speciality_add.AddItem (strSpecialityInformation)
        RstSpecialities.MoveNext
    Next
    'close the recordet
    RstSpecialities.Close
End Sub

我在谷歌上搜索了很长时间，试图解决这个问题 - 但运气不佳。感谢所有回复的人。

编辑：

这出现了两次 - 如果我两次都输入“11”（DJ 编号）然后我得到一个列表 - 但它显示如下：

这似乎是我的 tblDJSpecialty 中的所有记录

Answer 1

下面是一些代码，可以 add/delete 区分两个列表框。但首先，一些解释：

左侧的列表框 (lst_specialities) 用于个别 DJ 专业
右侧的列表框 (lst_specialities_All) 包含所有可供选择的专业
tblSpeciality 有两列：(1) SpecialityNo, AutoNumber, PK; (2) 专业名称文本
Table tblDJSpecialityID 有 3 列：(1) DJSpecialityID 自动编号，PK； (2) DJ_FKDjNo LongInt(DJ的PK); (3) FKSpecialityNo, LongInt (专业PK)
更改用于匹配您名字的名称。

以下是首选项列表框的行源SQL 'lst_specialities'

SELECT tblDJSpecialitiy.DJSpecialityID, tblDJSpecialitiy.DJ_FKDjNo, tblDJSpecialitiy.FKSpecialityNo, tblSpeciality.SpecialityName FROM tblDJSpecialitiy 
INNER JOIN tblSpeciality ON tblDJSpecialitiy.FKSpecialityNo = tblSpeciality.SpecialityNo 
WHERE (((tblDJSpecialitiy.DJ_FKDjNo)=[Forms]![dj_edit]![txt_dj_no]));

下面是listbox的rowsource 'lst_specialities_All':

SELECT tblSpeciality.SpecialityNo, tblSpeciality.SpecialityName 
FROM tblSpeciality ORDER BY tblSpeciality.SpecialityName;

以下是添加/删除的代码。我将命令按钮命名为 cmdPlus 和 cmdMinus：

Option Compare Database
Option Explicit

Private Sub Form_Current()
    Me.lst_specialities.Requery
End Sub

Private Sub cmdMinus_Click()
Dim strSQL  As String
Dim i       As Integer

    If Me.lst_specialities.ItemsSelected.Count = 0 Then
        MsgBox "You must select a specialty to remove from this DJ.", vbOKOnly, "No Specialty Selected"
        Exit Sub
    End If

    For i = 0 To 3
        Debug.Print i & vbTab & Me.lst_specialities.Column(i)
    Next i
    strSQL = "DELETE tblDJSpecialitiy.DJSpecialityID, tblDJSpecialitiy.FKSpecialityNo " & _
                "FROM tblDJSpecialitiy " & _
                "WHERE (((tblDJSpecialitiy.DJSpecialityID)=" & Me.lst_specialities.Column(0) & "));"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    UnSelect_All
    UnSelect_DJ
    Me.lst_specialities.Requery
End Sub

Private Sub cmdPlus_Click()
Dim strSQL  As String
Dim i       As Integer


    If Me.lst_specialities_All.ItemsSelected.Count = 0 Then
        MsgBox "You must select a specialty to add to this DJ.", vbOKOnly, "No Specialty Selected"
        Exit Sub
    End If

    For i = 0 To 3
        Debug.Print i & vbTab & Me.lst_specialities_All.Column(i)
    Next i
    strSQL = "INSERT INTO tblDJSpecialitiy ( DJ_FKDjNo, FKSpecialityNo ) " & _
            "SELECT " & Me.txt_dj_no & " AS Expr1, " & Me.lst_specialities_All.Column(0) & " AS Expr2;"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    UnSelect_All
    UnSelect_DJ

    Me.lst_specialities.Requery
End Sub

Function UnSelect_All()
Dim i  As Integer
    For i = 0 To Me.lst_specialities_All.ListCount             'Deselect ALL rows in Listbox
        lst_specialities_All.Selected(i) = False
    Next i

End Function
Function UnSelect_DJ()
Dim i  As Integer
    For i = 0 To Me.lst_specialities.ListCount             'Deselect ALL rows in Listbox
        lst_specialities.Selected(i) = False
    Next i

End Function

在 Access 2013 中使用 VBA 从列表框中分配选项

Assigning options from Listbox using VBA in Access 2013

ms-access

vba

ms-access-2013