Using the Control Key on a Listbox
- From: Cameron <Cameron@xxxxxxxxxxxxxxxxxxxxxxxxx>
- Date: Tue, 28 Aug 2007 08:48:04 -0700
I have a form that the users use to define attendees for tabulation of
courses. On the one side is a filtered listbox that lists all the employees,
and on the other side of the form is a listbox that gets filled when a button
is pressed. The user is to select the employees that will be attending from
the first listbox and then press the input button to transfer those employee
names to the second listbox. I have had a request by one user to be able to
block transfer employees by using the control keys. I have noticed that
holding down the control key results in being able to block select employees
in the listbox, but when the transfer button is pressed only the last clicked
on employee gets transfered. How might I assure that all those employees in
the block selected get moved?
the code for the transfer button is as follows:
Private Sub MoveToAttendees_Click()
On Error GoTo MoveToAttendeesError
Dim MyDB As Database
Dim MyStudents As Recordset
Dim MyEmployees As Recordset
Dim vExpiryDate As String
Dim I, X As Integer
Set MyDB = CurrentDb
Set MyStudents = MyDB.OpenRecordset("SessionAttendance")
DoCmd.Hourglass True
If [Forms]![CoursesMain]![RecertPeriod] <> 99 Then
vExpiryDate = DateAdd("d", (365 *
[Forms]![CoursesMain]![RecertPeriod]), Me.Date)
Else
vExpiryDate = "01-Jan-2999"
End If
For I = 0 To Me.EmployeesList.ListCount - 1
'MsgBox "on item # " & I
If Me!EmployeesList.Selected(I) = True Then
With MyStudents
.AddNew
!CourseID = Me.CourseID
!SessionID = Me.SessionID
!EmpID = Me.EmployeesList.ItemData(I)
!Attended = True
.Update
AttendAdd Forms!CoursesMain!TrainingType, Me.CourseID,
Me.SessionID, Me.EmployeesList.ItemData(I), Me.Date, vExpiryDate
End With
End If
Next I
MyStudents.Close
MyDB.Close
Set MyDB = Nothing
Form.Refresh
DoCmd.Hourglass False
Me.MoveToAttendees.DefaultValue = False
Exit Sub
MoveToAttendeesError:
If err.Number = 3022 Then 'Duplicate record
MsgBox "The employee '" & Me!EmployeesList.Column(2, I) & " " &
Me!EmployeesList.Column(1, I) & _
"' is already attending this session."
End If
If err.Number = 3140 Then Resume Next
'Else
'MsgBox Error$ & err.Number
'End If
Form.Refresh
MyStudents.Close
MyDB.Close
Set MyDB = Nothing
DoCmd.Hourglass False
Me.MoveToAttendees.DefaultValue = False
End Sub
.
- Prev by Date: Re: emailing
- Next by Date: RE: Set appointments in Outlook from Access 2002
- Previous by thread: Form went blank - don't know why???
- Next by thread: RE: Set appointments in Outlook from Access 2002
- Index(es):
Relevant Pages
|
