Add the following function to the form's module:
Function ReportList(fld As Control, ID As Variant, row As Variant, col As
Variant, Code As Variant) As Variant
Dim dbs As DAO.Database
Dim doc As DAO.Document
Dim ctr As DAO.Container
Dim varReturnVal As Variant
Dim n As Integer
Static intEntries As Integer
Static aData() As Variant
Select Case Code
Case acLBInitialize
Set dbs = CurrentDb
Set ctr = dbs.Containers("Reports")
intEntries = ctr.Documents.Count
ReDim aData(intEntries)
For Each doc In ctr.Documents
aData(n) = doc.Name
n = n + 1
Next doc
varReturnVal = True
Case acLBOpen
varReturnVal = Timer
Case acLBGetRowCount
varReturnVal = intEntries
Case acLBGetColumnCount
varReturnVal = 1
Case acLBGetColumnWidth
varReturnVal = -1
Case acLBGetValue
varReturnVal = aData(row)
Case acLBEnd
Erase aData
End Select
ReportList = varReturnVal
End Function
Set the RowSourceType property of the combo box to:
ReportList
Leave its RowSource property blank.
In its AfterUpdate event procedure put:
Dim ctrl As Control
Dim strReport As String
Set ctrl = Me.ActiveControl
If Not IsNull(ctrl) Then
strReport = ctrl
DoCmd.OpenReport _
ReportName:=strReport, _
View:=acViewPreview
End If
That will list all reports by name, including sub-reports. A better
solution is to list only those reports which are not subreports by means of
some form of naming convention. In the example below such reports names
begin with 'rpt'. Rather than listing the names of the objects you can list
their Description properties, as set in the database window. This enables
you to give each report a meaningful description which the user can select
from the list rather than a cryptic name. Any reports without a Description
property will not be listed. For this the control's ColumnWidths property
should be set to 0cm;8cm (Access will convert this to inches if using
imperial units) and the function is as follows:
Function ReportList(fld As Control, ID As Variant, row As Variant, col As
Variant, Code As Variant) As Variant
Dim dbs As DAO.Database
Dim doc As DAO.Document
Dim ctr As DAO.Container
Dim varReturnVal As Variant
Dim n As Integer
Static intEntries As Integer
Static aData() As Variant
Select Case Code
Case acLBInitialize
Set dbs = CurrentDb
Set ctr = dbs.Containers("Reports")
intEntries = ctr.Documents.Count
ReDim aData(intEntries, 1)
For Each doc In ctr.Documents
If Left(doc.Name, 3) = "rpt" Then
aData(n, 0) = doc.Name
On Error Resume Next
aData(n, 1) = doc.Properties("Description")
If Err = 0 Then
n = n + 1
Else
intEntries = intEntries - 1
End If
On Error GoTo 0
Else
intEntries = intEntries - 1
End If
Next doc
varReturnVal = True
Case acLBOpen
varReturnVal = Timer
Case acLBGetRowCount
varReturnVal = intEntries
Case acLBGetColumnCount
varReturnVal = 2
Case acLBGetColumnWidth
varReturnVal = -1
Case acLBGetValue
varReturnVal = aData(row, col)
Case acLBEnd
Erase aData
End Select
ReportList = varReturnVal
End Function
Functions of the above type are known as 'call back' functions because they
are repeatedly called by Access, passing a different argument each time.
These should work with all versions of Access, but with more recent versions
combo or list boxes support an AddItem method which can be used instead.
Ken Sheridan
Stafford, England
