Generate a Table of Contents for a report

[STGE]

I have a report on my MS Access application which I would like to create a Table Of Content for. The problem is that MS Access cant do this automatically.

The solution I'm working with now is to create a table that stores the Headings and Page numbers when a Header is printed in the report. This works fine but the problem is that I have to scroll through my detailed rapport to store all the Heading page numbers in my t_TOC table.

The length of my detailed rapport vary a lot and it is not a good solution to let the user scroll through this rapport and then generate a TOC and finally print them out separately.

Is there a way to open the report in VBA (DoCmd.OpenReport "Report", acViewPreview)

And then run to the last page? .. or do any of you have any other solutions?

I want my main report to look like this:

- Cover Page [Main Report]
- Table Of Contents [Subreport]
- Details (vary from 13-230 pages) [Subreport]

 

[TKnight]

You can do this with VBA because when Access creates a report it goes through the entire report source so you could append each heading and it's page number (on the heading format event) to a Temporary table and then print a single page report based on that table before the main body of the report is printed.

If you are comfortable with VBA you can do it that way and there should be enough examples on the forum to give you the code but if you are not comfortable with VBA then I would say it's probably too big a task. Sorry I don't have time to make you a working example otherwise I would... any takers?

Tom

 

[STGE]

Hi again

Yes I'm familliar with VBA but still cant get it to work. When opening a report through VBA the report is not run through and the TOC can therefore not be generated. Here is where I am now:

The table t_TOC which contains the table of contents that is generated when the report is either printed, or shown in print preview and then manually scrolled down to the last page.

My plan is now to only print the TOC when repport is sent to printer, because then the t_TOC is generated and ready to print afterwards.

Now I'm stuck here: How can I print a my report by choosing a custom printer? This only prints with default printer:

DoCmd.OpenReport "r_name", acViewNormal, , , acHidden

The name of the printer I want to use is stored in the a variable.

Another problem is that I can't send this variable from one Form to another.

Public gbl_strReportName As String

A form can't contain a Global xxx As Sting so how do I solve this?

Here is my code so far (not complete with error_handler etc.)

In the form that prints the report:

Option Compare Database
Option Explicit
Public gbl_strReportName As String
Private Sub Form_Open(Cancel As Integer)
        Dim strTemp, strMsg, strReport As String
        'Load the combo with names of the installed printers.
        strTemp = GetPrinters()
        If Len(strTemp) = 0 Then
            MsgBox "No installed printers found."
            DoCmd.Close acForm, Me.name, acSaveNo
        Else
            Me.cboPrinter.RowSource = """[Default Printer]"";" & strTemp
            Me.cboPrinter.Value = "[Default Printer]"
        End If
End Sub
 
Private Sub cmdCancel_Click()
    DoCmd.Close acForm, Me.name, acSaveNo
End Sub
 
Private Sub cmdOK_Click()
    'Purpose:   Print the report to selected printer.
 
    'If the report is alreay open, close it to ensure the data it contains is updated.
    If CurrentProject.AllReports("r_xxx").IsLoaded Then
        DoCmd.Close acReport, "r_xxx", acSaveNo
    End If
    'print report to default printer
    DoCmd.OpenReport "r_xxx", acViewNormal, , , acHidden 'THIS IS WHERE HELP IS NEEDED
    DoCmd.OpenReport "r_TOC", acViewNormal, , , acHidden
 
    DoCmd.Close acReport, "r_TOC", acSaveNo
    DoCmd.Close acForm, Me.name, acSaveNo
End Sub
 
Private Function GetPrinters() As String
    'Purpose:   Return a delimited string of installed printers.
    'Usage:     Assign to RowSource of a combo that has RowSourceType of Value List.
On Error GoTo Err_Handler
 
    Dim prn As Printer
    Dim strPrinter As String
 
    If Application.Printers.count > 0 Then
        'Create delimited list of printers for Value List of combo.
        For Each prn In Application.Printers
            strPrinter = strPrinter & """" & prn.DeviceName & """;"
        Next
        GetPrinters = Left$(strPrinter, Len(strPrinter) - 1)
    End If
Exit_Handler:
    Set prn = Nothing
    Exit Function
Err_Handler:
    MsgBox "A problem occured when trying to detect printers installed on this computer"
    Resume Exit_Handler
End Function

 

[STGE]

Solved

Problem solved!!

At last I found a solution that works, but if any of you have better ideas the please let me know!!

I will post my code here if any of you need it:

1. In the form that has to print the report I have this button that runs the

function ChoosePrinter()
Private Sub cmd_print_Click()
    'Print report
    Call ChoosePrinter(Me.name)
End Sub

2. Then I have a form called f_ChoosePrinter where the user choose a printer:

Option Compare Database
Option Explicit
Private Sub Form_Load()
        Dim strPrinters As String
        'Load the combo with names of the installed printers.
        strPrinters = GetPrinters()
        If Len(strPrinters) = 0 Then
            MsgBox "No installed printers found."
            DoCmd.Close acForm, Me.name, acSaveNo
        Else
            Me.cboPrinter.RowSource = """[Default Printer]"";" & strPrinters
            Me.cboPrinter.Value = "[Default Printer]"
        End If
End Sub
Private Sub cmdCancel_Click()
    DoCmd.Close acForm, Me.name, acSaveNo
End Sub
Private Sub cmdOK_Click()
    'print report
    Call PrintReport(Me.cboPrinter.Value)
    DoCmd.Close acForm, Me.name, acSaveNo
End Sub

3. And a module with all the printing functions, functions PrintReport(), ChoosePrinter() and GetPrinters():

Option Compare Database
Option Explicit
Public strReport As String
Function PrintReport(strPrinter As String)
'On Error GoTo Err_Handler
    'If the report is alreay open close it to make sure the right data is loaded.
    If CurrentProject.AllReports(strReport).IsLoaded Then
        DoCmd.Close acReport, strReport, acSaveNo
    End If
 
    'Set printer
    If Len(strPrinter) = 0 Or strPrinter = "[Default Printer]" Then
        'Restore to default printer
        Set Application.Printer = Nothing
    Else
        'Do nothing if printer is already set.
        If Not Application.Printer.DeviceName = strPrinter Then
            Set Application.Printer = Application.Printers(strPrinter)
        End If
    End If
    'Open/print the report
     DoCmd.OpenReport strReport, acViewNormal, , , acHidden
    'Open/print the TOC for the report
     DoCmd.OpenReport "r_TOC", acViewNormal, , , acHidden
 
    'Close the report again
    DoCmd.Close acReport, strReport, acSaveNo
    DoCmd.Close acReport, "r_TOC", acSaveNo
End Function
Function ChoosePrinter(strForm As String)
'Purpose:   Save the report name of the report to be printed and open the form f_ChoosePrinter.
 
    'saves the name of the report for printing in a public variable ex if form is f_name the report is r_name
    strReport = "r_" & Right$(strForm, Len(strForm) - 2)
    'Let the user choose printer for the report
    DoCmd.OpenForm "f_ChoosePrinter"
End Function
Function GetPrinters() As String
    'Purpose:   Return a string of installed printers.
    'Usage:     Assign to RowSource of a combo that has RowSourceType of Value List.
On Error GoTo Err_Handler
 
    Dim prn As Printer
    Dim strPrinter As String
 
    If Application.Printers.count > 0 Then
        'Create delimited list of printers for Value List of combo.
        For Each prn In Application.Printers
            strPrinter = strPrinter & """" & prn.DeviceName & """;"
        Next
        GetPrinters = Left$(strPrinter, Len(strPrinter) - 1)
    End If
Exit_Handler:
    Set prn = Nothing
    Exit Function
Err_Handler:
    MsgBox "A problem occured when trying to detect printers installed on this computer"
    Resume Exit_Handler
End Function

4. And finaly a module where I save the data for the TOC in a table:

In the proberties for the report is set in On Open: =InitToc()

In the properties for the header where I want the pagenumber when the header is printed
On Print: =UpdateToc(["The name of the 1 heading I whant to store"];["The name of the 1 heading I whant to store]";[Report])

Option Compare Database
Option Explicit
Dim db As Database
Dim toctable As Recordset
'Global gbl_strReportName As String
Function InitToc()
    ' Called from the OnOpen property of the report.
    ' Opens the database and the table for the report.
    Dim qd As QueryDef
    Set db = CurrentDb()
    ' Delete all previous entries in Table of Contents table.
    Set qd = db.CreateQueryDef("", "Delete * From t_TOC")
    qd.Execute
    qd.Close
    ' Open the table.
    Set toctable = db.OpenRecordset("t_TOC", DB_OPEN_TABLE)
    toctable.Index = "Description"
End Function
Function UpdateToc(tocentry1 As String, tocentry2 As String, Rpt As Report)
' Call from the OnPrint property of the section containing
' the Table Of Contents Description2 field. Updates the Table Of
' Contents table.
    toctable.Seek "=", tocentry1
    toctable.Seek "=", tocentry2
    If toctable.NoMatch Then
        toctable.AddNew
        toctable!Description1 = tocentry1
        toctable!Description2 = tocentry2
        toctable!Page_number = Rpt.Page
        toctable.Update
    End If
End Function

And I think this was it.... Just ask if you have any questions or please post if you have a better sugestion for solving this!!

-Stine