I created a list box that has items to be selected. and made the multi-sleection so several items could be selected.
And since the listbox had 100's of items. Each item clicked stayed highlighted so the user could go back and double check them.
Then in the list box on_click event I got the item and created a new record in a subform and added the list.column(x) to the appropiate field in the subform.
So as the user clicked an item in the listbox it showed in the subform below. And then I created a report that looked at the table where the subform was attached.
When the user clicked print it printed the records out then put a check in a Printed field so it was ready for next time. the subform showed no records. In other words all of the items ever choosen where there with the date and did not show on the subform becuse it had a check in a field I was monitoring.
So you can't actually drag records but you can click on it and have it go to another control.
here is the code for the list box
----------------------------------
Private Sub List0_Click()
Dim ctlList As Control, varItem As Variant
Dim Counter1, retval As Variant
GoTo skip
retval = InputBox("Please enter Qty", "Qty to do", Me![List0].Column(5))
If retval = "" Then
' remove selection from list cause it was canceled
Me!List0.Selected(List0.ListIndex + 1) = False
Exit Sub
End If
skip:
Set ctlList = Me!List0
For Each varItem In ctlList.ItemsSelected
' Print value of bound column.
'Counter1 = Counter1 + 1
Next varItem
Text2 = Counter1
Me![Just Print These subform].SetFocus
DoCmd.GoToRecord , , acNewRec
Me![Just Print These subform].Form![STOCK_CODE] = Me![List0].Column(0)
Me![Just Print These subform].Form![Description] = Me![List0].Column(1)
Me![Just Print These subform].Form![ON HAND QTY] = Me![List0].Column(2)
Me![Just Print These subform].Form![SAFETY STOCK LVL] = Me![List0].Column(3)
Me![Just Print These subform].Form![ON ORD QTY] = Me![List0].Column(4)
'Me![Just Print These subform].Form![Qty to Make] = retval
Me![Just Print These subform].Form![Qty to Make] = Me![List0].Column(5)
Me![Just Print These subform].Form![DateAdded] = Format(Now, "mm/dd/yy"
Me![Just Print These subform].Form![LastCost] = Me![List0].Column(6)
End Sub
---------------------------
Code for print button
---------------------------
Private Sub cmd_Print_Manufactured_Click()
On Error GoTo Err_cmd_Print_Manufactured_Click
Dim stDocName As String
stDocName = "Safety Stock Level Manufactured"
DoCmd.OpenReport stDocName, acNormal
'Archive items to History Table
ArchiveItems
' Remove Highlited items from top list
Dim ctlList As Control, varItem As Variant
Set ctlList = Me!List0
For Each varItem In ctlList.ItemsSelected
' Print value of bound column.
ctlList.Selected(varItem) = False
Next varItem
Exit_cmd_Print_Manufactured_Click:
Exit Sub
Err_cmd_Print_Manufactured_Click:
MsgBox Err.Description
Resume Exit_cmd_Print_Manufactured_Click
End Sub
-------------------------
Archive code
--------------------------
Public Sub ArchiveItems()
On Error GoTo Err_ArchiveItems
' Archive to History folder
Dim dbs As Database, qdf As QueryDef
Dim strSQL As String
'delete items from table
DoCmd.DeleteObject acQuery, "UpdateTitles"
' Return reference to current database.
Set dbs = CurrentDb
strSQL = "INSERT INTO [History Just Print These] (STOCK_CODE, DESCRIPTION, QTY_ON_HAND, SAFETY_STOCK_QTY, QTY_ON_ORDER, [Qty to Make], DateAdded) SELECT [Just Print These].STOCK_CODE, [Just Print These].DESCRIPTION, [Just Print These].QTY_ON_HAND, [Just Print These].SAFETY_STOCK_QTY, [Just Print These].QTY_ON_ORDER, [Just Print These].[Qty to Make], [Just Print These].[DateAdded] FROM [Just Print These];"
' Create new QueryDef.
Set qdf = dbs.CreateQueryDef("UpdateTitles", strSQL)
' Execute QueryDef.
qdf.Execute
qdf.Close
dbs.Close
'Delete Items in list
DoEvents
Set dbs = CurrentDb
Dim rst As Recordset
Set rst = dbs.OpenRecordset("Just Print These"
rst.MoveLast
For a = rst.RecordCount To 1 Step -1
rst.Delete
rst.MovePrevious
Next
rst.Close
dbs.Close
Forms![frm-Safety Stock level]![Just Print These subform].Requery
Exit_ArchiveItems:
Exit Sub
Err_ArchiveItems:
Select Case Err.Number
Case 3011
' No update query to delete
Resume Next
Case Else
MsgBox "Error # " & Err.Number & " " & Err.Description, vbInformation, "In sub ArchiveItems"
Resume Exit_ArchiveItems
End Select
End Sub
This works very well and is used alot at our company....
[sig]<p>DougP, MCP<br><a href=mailto: dposton@universal1.com> dposton@universal1.com</a><br><a href= > </a><br> Ask me how Bar-codes can help you be more productive.[/sig]
