Option Compare Database
Private Sub cmdPreview_Click()
On Error GoTo Err_Handler
'Purpose: Open the report filtered to the items selected in the list box.
'Author: Allen J Browne, 2004.
Dim varItem As Variant 'Selected items
Dim strWhere As String 'String to use as WhereCondition
Dim strDescrip As String 'Description of WhereCondition
Dim lngLen As Long 'Length of string
Dim strDelim As String 'Delimiter for this field type.
Dim strDoc As String 'Name of report to open.
'strDelim = """" 'Delimiter appropriate to field type. See note 1.
strDoc = "Products by Category"
'Loop through the ItemsSelected in the list box.
With Me.lstCategory
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
'Build up the filter from the bound column (hidden).
strWhere = strWhere & strDelim & .ItemData(varItem) & strDelim & ","
'Build up the description from the text in the visible column. See note 2.
strDescrip = strDescrip & """" & .Column(1, varItem) & """, "
End If
Next
End With
'Remove trailing comma. Add field name, IN operator, and brackets.
lngLen = Len(strWhere) - 1
If lngLen > 0 Then
strWhere = "[CategoryID] IN (" & Left$(strWhere, lngLen) & ")"
lngLen = Len(strDescrip) - 2
If lngLen > 0 Then
strDescrip = "Categories: " & Left$(strDescrip, lngLen)
End If
End If
'Report will not filter if open, so close it. For Access 97, see note 3.
If CurrentProject.AllReports(strDoc).IsLoaded Then
DoCmd.Close acReport, strDoc
End If
'Omit the last argument for Access 2000 and earlier. See note 4.
DoCmd.OpenReport strDoc, acViewPreview, WhereCondition:=strWhere, OpenArgs:=strDescrip
Exit_Handler:
Exit Sub
Err_Handler:
If Err.Number <> 2501 Then 'Ignore "Report cancelled" error.
MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdPreview_Click"
End If
Resume Exit_Handler
End Sub
Function ClearList(lst As ListBox) As Boolean
On Error GoTo Err_ClearList
'Purpose: Unselect all items in the listbox.
'Return: True if successful
'Author: Allen Browne.
June, 2006.
Dim varItem As Variant
If lst.MultiSelect = 0 Then
lst = Null
Else
For Each varItem In lst.ItemsSelected
lst.Selected(varItem) = False
Next
End If
ClearList = True
Exit_ClearList:
Exit Function
Err_ClearList:
Call LogError(Err.Number, Err.Description, "ClearList()")
Resume Exit_ClearList
End Function
Public Function SelectAll(lst As ListBox) As Boolean
On Error GoTo Err_Handler
'Purpose: Select all items in the multi-select list box.
'Return: True if successful
'Author: Allen Browne.
June, 2006.
Dim lngRow As Long
If lst.MultiSelect Then
For lngRow = 0 To lst.ListCount - 1
lst.Selected(lngRow) = True
Next
SelectAll = True
End If
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, "SelectAll()")
Resume Exit_Handler
End Function
Private Sub SelectAll_Click()
Call SelectAll(Me.lstCategory)
End Sub
