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!
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!