Drop and Drag in a list box

[losthome]

Hi There,

I tried posting this yesterday, but I can't find it.

I have a problem with my code for Drop and Drag from one list box to the other. What i am trying to do is Pick a trainining course, put in the date, and the length of the course. Then I need to add the people that Attended the course.

So I have a list box that contains all the employees of a company. I want to choose one at time and put them over to the second list box to say they attended the course. Then I need it to save the information into my training table.


I can't get the code to work right. I am willing to email anyone an example of what I am trying to do.

It gets hung up with parts of the module. I found an example on the internet and I am trying to get it to work with my DB.

Any suggestions?

Thanks

Jen

SQL view of first list box
SELECT [tbl-Employee Info].EmployeeID, [tbl-Employee Info].LastName, [tbl-Employee Info].Selected
FROM [tbl-Employee Info]
WHERE ((([tbl-Employee Info].Selected)=True))
GROUP BY [tbl-Employee Info].EmployeeID, [tbl-Employee Info].LastName, [tbl-Employee Info].Selected
HAVING ((([tbl-Employee Info].Selected)=False))
ORDER BY [tbl-Employee Info].LastName;


Second List box
SELECT [tbl-Employee Info].Selected, [tbl-Employee Info].EmployeeID, [tbl-Employee Info].LastName
FROM [tbl-Employee Info]
WHERE ((([tbl-Employee Info].Selected)=True));


Code for the event procedures:


Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DragStart Me
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DropDetect Me, Me![List1], Button, Shift, X, Y
End Sub

Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DragStop
End Sub

Private Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DragStart Me
End Sub

Private Sub List2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DropDetect Me, Me![List2], Button, Shift, X, Y
End Sub

Private Sub List2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DragStop
End Sub


Module

Option Compare Database
Option Explicit

Dim DragFrm As Form
Dim DragCtrl As Control
Dim DropTime

Const MAX_DROP_TIME = 0.1

Dim CurrentMode As Integer
Const NO_MODE = 0
Const DROP_MODE = 1
Const DRAG_MODE = 2

Sub DragStart(SourceFrm As Form)
' NOTE: You should not use Screen.ActiveForm in place of
' SourceFrm because you may be dragging from a subform.
Set DragFrm = SourceFrm
Set DragCtrl = Screen.ActiveControl
CurrentMode = DRAG_MODE
End Sub

Sub DragStop()
CurrentMode = DROP_MODE
DropTime = Timer
End Sub

Sub DropDetect(DropFrm As Form, DropCtrl As Control, _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
' If a drop hasn't happened, then exit.
If CurrentMode <> DROP_MODE Then Exit Sub
CurrentMode = NO_MODE

' The timer interval is permitted between the MouseUp event and
' the MouseMove event. This ensures that the MouseMove event does
' not invoke the Drop procedure unless it is the MouseMove event
' that Microsoft Access automatically fires for the Drop control
' following the MouseUp event of a drag control. Subsequent
' MouseMove events will fail the timer test and be ignored.

If Timer - DropTime > MAX_DROP_TIME Then Exit Sub

' Did we drag/drop onto ourselves?
If (DragCtrl.Name <> DropCtrl.Name) Or _
(DragFrm.hWnd <> DropFrm.hWnd) Then
' If not, then a successful drag/drop occurred.
DragDrop DragFrm, DragCtrl, DropFrm, DropCtrl, Button, Shift, X, Y
End If
End Sub


Sub DragDrop(DragFrm As Form, DragCtrl As Control, DropFrm As Form, DropCtrl As Control, _
Button As Integer, Shift As Integer, X As Single, Y As Single)
' Which form was dropped on?
' It is a good idea to use the DragDrop procedure to
' determine which drag-and-drop operation occurred; then call
' appropriate code to handle the special cases.
Select Case DropFrm.Name
Case "frmDragDropListBoxes"
ListBoxExample DragFrm, DragCtrl, DropFrm, DropCtrl, _
Button, Shift, X, Y
Case Else
' For all other cases, copy contents of Drag to Drop
' control.
On Error Resume Next
DropCtrl = DragCtrl
If Err Then MsgBox Error$
End Select
End Sub

Sub ListBoxExample(DragFrm As Form, DragCtrl As Control, DropFrm As Form, DropCtrl As Control, _
Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DB As DATABASE
Dim SQL As String

Set DB = CurrentDb()

' Create SQL statement to update Selected field of
' .. drag/dropped list box item.
SQL = "UPDATE tbl-Employee Info SET Selected="

' Drag from List1 toggle Selected=True, List2 toggles False.
SQL = IIf(DragCtrl.Name = "List1", SQL & "True", SQL & "False")
' If CTRL key not used, alter dragged value only.
If (Shift And CTRL_MASK) = 0 Then
SQL = SQL & " WHERE [EmployeeID]='" & DragCtrl & "'"
End If

' Run update query to toggle Selected field of Customer record(s).
DB.Execute SQL

' Requery the list box controls to show update lists.
DragCtrl.Requery
DropCtrl.Requery

End Sub