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

Question

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

图片应该比我描述它更容易解释功能：

很简单，我希望用户能够单击“添加”，然后双击其中一个专业将其分配给该 DJ。

当用户单击保存按钮时，需要为他们选择的每个专业在名为“tblDJSpecialitiy”的表中创建一个新行。每行都需要包含“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

下面是一些将在两个列表框之间添加/删除特殊功能的代码。但首先，有一些解释：

• 左侧的列表框 (lst_specialities) 用于各个 DJ 专业
• 右侧的列表框 (lst_specialities_All) 包含所有可供选择的专业
• tblSpeciality 有两列：(1) SpecialityNo、AutoNumber、PK； (2) 专业名称文本
• 表 tblDJSpecialityID 有 3 列： (1) DJSpecialityID AutoNumber, PK； （2）DJ_FKDjNo LongInt（DJ的PK）； (3) FKSpecialityNo, LongInt（专业PK）
• 更改用于匹配您的姓名的名称。

• 以下是Preferences列表框'lst_specialities'的rowsource SQL

  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]));
  

• 以下是列表框'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