AddAllToList to open a report

J

JOM

I have unbound combobox that I would like to select all so that it can open a
report based on all. It does contain each individual but there are times
that one would like to preview all the individuals. there are 2 other
unbound textboxes that contain begin and ending date. so if I select the all
and then put in the begin date and ending date it should be able to open a
report. it works well with each individual but I am not able to select all.

Below is the code I found on solutions 2000 that adds all to a listbox or
combobox
***********************************************************
Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _
lngCol As Long, intCode As Integer) As Variant

' Adds "(All)" to the top of a combo box or list box.

' You can add "(All)" in a different column of the combo box
' or list box by setting the control's Tag property to a different
' column number, or display text other than "(All)" by appending
' a semicolon(;) and the text you want to display. For example,
' setting the Tag property to "2;<None>" displays "<None>"
' in the second column of the list.

Static dbs As DAO.Database, rst As DAO.Recordset
Static lngDisplayID As Long
Static intDisplayCol As Integer
Static strDisplayText As String
Dim intSemiColon As Integer

On Error GoTo Err_AddAllToList
Select Case intCode
Case acLBInitialize
' See if function is already in use.
If lngDisplayID <> 0 Then
MsgBox "AddAllToList is already in use by another control!"
AddAllToList = False
Exit Function
End If

' Parse the display column and display text from Tag property.
intDisplayCol = 1
strDisplayText = "(All)"
If Not IsNull(ctl.Tag) Then
intSemiColon = InStr(ctl.Tag, ";")
If intSemiColon = 0 Then
intDisplayCol = Val(ctl.Tag)
Else
intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1))
strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
End If
End If

' Open the recordset defined in the RowSource property.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)

' Record and return the lngID for this function.
lngDisplayID = Timer
AddAllToList = lngDisplayID

Case acLBOpen
AddAllToList = lngDisplayID

Case acLBGetRowCount
' Return number of rows in recordset.
On Error Resume Next
rst.MoveLast
AddAllToList = rst.RecordCount + 1

Case acLBGetColumnCount
' Return number of fields (columns) in recordset.
AddAllToList = rst.Fields.Count

Case acLBGetColumnWidth
AddAllToList = -1

Case acLBGetValue
If lngRow = 0 Then
If lngCol = intDisplayCol - 1 Then
AddAllToList = strDisplayText
Else
AddAllToList = Null
End If
Else
rst.MoveFirst
rst.Move lngRow - 1
AddAllToList = rst(lngCol)
End If
Case acLBEnd
lngDisplayID = 0
rst.Close
End Select

Bye_AddAllToList:
Exit Function

Err_AddAllToList:
MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
AddAllToList = False
Resume Bye_AddAllToList
End Function
***********************************************************


below is what I have in my combobox after event procedure


Private Sub cmbDaily_AfterUpdate()
' Return record(s) that match value selected in cmbDaily combo box.
If Len(Me!cmbDaily.Column(1)) = 0 Then
DoCmd.OpenReport "ServiceLevel", acViewPreview
Else
DoCmd.ApplyFilter , "EmpID =[Forms]![FrmServiceLevel]![cmbDaily]"
End If
End Sub

************************************************************

My preview button has the following code

Private Sub cmdPreview_Click()

Dim stDocName As String
Dim strWhereEmpl As String

If IsNull(Me.cmbDaily) Then
MsgBox "Select an employee to Preview."
Me.cmbDaily.SetFocus
Exit Sub
End If

strWhereEmpl = "EmpID = " & Forms![FrmServiceLevel]!cmbDaily
stDocName = "ServiceLevel"

DoCmd.OpenReport stDocName, acPreview, , strWhereEmpl
End Sub
***********************************************************

Please help!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top