Date:  Sun, 25 Feb 2001 11:57:20 -0800 (PST)

From: Manolis Manolas <mmsoft@r...>  | Block address

Subject: Reports from crosstab query in Access97 with variable headings

To: Access <access@p...>



The Problem I had to solve:

There are some documents, containing Amounts relevant with some

Cost-Centers.

The Supervisor needs a report showing Owners of the documents on the

left,

   Cost-Centers on Head boxes and Sums of Amounts in detail boxes, also

   Totals for each Owner on the right column, also

   Totals for each Cost-Center on the bottom row.

There are Hundreds of Cost-Centers but the crosstab report should show

sorted

   only the Cost-Centers of the selected documents.



I will send to you a database with the reports without their code

in a private e-mail, because wrox list manager does not allow 

attachments, as I have found out (that explains some of the delay

of this answer to your question).

 

The code follows. I believe it will help.

Regards

Manolas Emmanuel, 20010225.Sun 

===============================================================================



Code for report R015_10_Supervisor_Report

-------------------------------------------------------------------------------

Option Compare Database

Option Explicit

'  Original by Manolas Emmanuel, 971015.Wed

'  Contact e-mail : mmsoft@r... 

'  You may use this code, keeping intact these lines of comment. Thanks



Private Sub Report_NoData(Cancel As Integer)

'  Original by Manolas Emmanuel, 971015.Wed

    

MsgBox "No records found for this report.", vbInformation, "Supervisor

Report"

Cancel = True



End Sub

===============================================================================



Code for report Z015_10_Subreport

-------------------------------------------------------------------------------

Option Compare Database

Option Explicit

'  Original by Manolas Emmanuel, 971015.Wed

'  Contact e-mail : mmsoft@r... 

'  You may use this code, keeping intact these lines of comment. Thanks

Const vAllowedColumns = 12

Const v2LogiMsg = "Name of your Application"

Dim vActualColumns As Integer

Dim vColumnTotal(1 To vAllowedColumns) As Double

Dim vReportTotal As Double

Dim vRowTotal As Double

Dim db1 As Database

Dim rsQ As Recordset



Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)

'  Original by Manolas Emmanuel, 971015.Wed

'  Place values in text boxes and hide unused text boxes.

Dim intX As Integer

Dim ValBeg As Integer

Dim ValLen As Integer

Dim thisValue As Double

Dim wheX As Integer

Dim I As Integer



'A note on labels : EE=ErrorExit, NE=NormalExit

On Error GoTo EE:

Again:

If Not rsQ.EOF Then

 If Me.FormatCount = 1 Then

  If rsQ(3) = "Headings" Then

   rsQ.MoveNext

   GoTo Again:

  End If

  For intX = 1 To 3

   Me("Col" + Format$(intX)) = Nz(rsQ(intX), 0)

  Next intX

  vRowTotal = 0

  For intX = 1 To vActualColumns

   GoSub FindValue:

   Me("Col" + Format$(intX + 3)) = thisValue

   vRowTotal = vRowTotal + thisValue

   vColumnTotal(intX + 3) = vColumnTotal(intX + 3) + thisValue

  Next intX

  Me("Col" + Format$(vActualColumns + 4)) = vRowTotal

  vReportTotal = vReportTotal + vRowTotal

  For intX = vActualColumns + 5 To vAllowedColumns

   Me("Col" + Format$(intX)).Visible = False

  Next intX

  rsQ.MoveNext

 End If

Else

 Cancel = True

End If

NE:

Exit Sub

EE:

MsgBox "[" & Err.Number & "] " & Err.Description, vbInformation,

v2LogiMsg

Cancel = True

Resume NE:



FindValue:

wheX = 0

For I = 1 To intX

 wheX = InStr(wheX + 1, rsQ(5), "=")

Next I

ValBeg = wheX + 1

ValLen = InStr(ValBeg, rsQ(5), "=") - ValBeg

thisValue = CDbl(Mid(rsQ(5), ValBeg, ValLen))

Return



End Sub



Private Sub Detail1_Retreat()

'  Original by Manolas Emmanuel, 971015.Wed

' Always back up to previous record when detail section retreats.



On Error Resume Next

If Not rsQ.BOF Then rsQ.MovePrevious



End Sub



Private Sub Report_Close()

'  Original by Manolas Emmanuel, 971015.Wed



On Error GoTo EE:

rsQ.Close

NE:

Exit Sub

EE:

MsgBox "[" & Err.Number & "] " & Err.Description, vbInformation,

v2LogiMsg

Resume NE:

End Sub



Private Sub Report_NoData(Cancel As Integer)

'  Original by Manolas Emmanuel, 971015.Wed

    

On Error GoTo EE:

'In a subreport I do not show messages for NoData condition

'MsgBox "No records found for this report.", vbInformation, "Supervisor

Report Crosstab"

rsQ.Close

NE:

Cancel = True

Exit Sub

EE:

MsgBox "[" & Err.Number & "] " & Err.Description, vbInformation,

v2LogiMsg

Resume NE:

End Sub



Private Sub Report_Open(Cancel As Integer)

'  Original by Manolas Emmanuel, 971015.Wed

'  Create underlying recordset for report

Dim intX As Integer



On Error GoTo EE:

If Not IsLoaded("Name_of_Form_Calling_the_Report") Then

 Cancel = True

Else

 vActualColumns = 0

 Set db1 = CurrentDb()

 Set rsQ = db1.OpenRecordset("SELECT * FROM [Z015_10_CrossTable] WHERE

(([Supervisor_Code] = " &

Forms![Name_of_Form_Calling_the_Report]![Supervisor_Code] & "));")

 If Not rsQ.EOF Then vActualColumns = rsQ(4)

 If vActualColumns > 0 Then

  If vActualColumns >= vAllowedColumns Then

   Cancel = True

   MsgBox "Not possible to create report with more than [" &

(vAllowedColumns - 1) & "] columns", vbInformation, "Supervisor Report"

   rsQ.Close

  End If

 Else

  Cancel = True

  MsgBox "No amounts found for this report", vbInformation, "Supervisor

Report"

  rsQ.Close

 End If

End If

NE:

Exit Sub

EE:

MsgBox "[" & Err.Number & "] " & Err.Description, vbInformation,

v2LogiMsg

Cancel = True

Resume NE:

End Sub



Private Sub ReportFooter4_Print(Cancel As Integer, PrintCount As

Integer)

'  Original by Manolas Emmanuel, 971015.Wed

'  Place column totals in text boxes in report footer

Dim intX As Integer



On Error GoTo EE:

For intX = 1 To vActualColumns

 Me("Tot" + Format$(intX + 3)) = vColumnTotal(intX + 3)

Next intX

Me("Tot" + Format$(vActualColumns + 4)) = vReportTotal

For intX = vActualColumns + 5 To vAllowedColumns

 Me("Tot" + Format$(intX)).Visible = False

Next intX

NE:

Exit Sub

EE:

MsgBox "[" & Err.Number & "] " & Err.Description, vbInformation,

v2LogiMsg

Cancel = True

Resume NE:

End Sub



Private Sub ReportHeader3_Format(Cancel As Integer, FormatCount As

Integer)

'  Original by Manolas Emmanuel, 971015.Wed

'  Move to first record in recordset at beginning of report

'      or when report is restarted. (A report is restarted

'      when you print a report from Print Preview window,

'      or when you return to a previous page while previewing.)

'  Put column headings into text boxes in page header.

Dim intX As Integer

Dim ValBeg As Integer

Dim ValLen As Integer

Dim thisTitle As String

Dim wheX As Integer

Dim I As Integer



On Error GoTo EE:

vReportTotal = 0

For intX = 1 To vAllowedColumns

 vColumnTotal(intX) = 0

Next intX

If Not rsQ.EOF Then

 If rsQ(3) = "Headings" Then

  Me("Head1") = ""

  Me("Head2") = "Document"

  Me("Head3") = "Owner"

  For intX = 1 To vActualColumns

   GoSub FindTitle:

   Me("Head" + Format$(intX + 3)) = thisTitle

  Next intX

  Me("Head" + Format$(vActualColumns + 4)) = "Totals"

  For intX = (vActualColumns + 5) To vAllowedColumns

   Me("Head" + Format$(intX)).Visible = False

  Next intX

  rsQ.MoveNext

 End If

Else

 Cancel = True

End If

NE:

Exit Sub

EE:

MsgBox "[" & Err.Number & "] " & Err.Description, vbInformation,

v2LogiMsg

Cancel = True

Resume NE:



FindTitle:

wheX = 0

For I = 1 To intX

 wheX = InStr(wheX + 1, rsQ(5), "=")

Next I

ValBeg = wheX + 1

ValLen = InStr(ValBeg, rsQ(5), "=") - ValBeg

thisTitle = Mid(rsQ(5), ValBeg, ValLen)

Return



End Sub

===============================================================================



--- Richard Taylor <richardt@g...> wrote:

> > In a similar situation I designed a report with unbound text boxes 

> > for headings and detail and then I used (extensive I must confess) 

> > vba code (behind the report) in order to fill with values the

> boxes.

> > > > --- Richard Taylor <richardt@g...> wrote:

> > > I have created a report from a crosstab query, the column

> headings of

> > > > > > which are actual dates. The report was created with the

wizard,

> and

> > > the 

> > > first time it was run, it worked fine. Two weeks later, i.e. when

> the

> > > > > > dates have moved on two weeks, the query has the correct

data,

> but

> > > the 

> > > report won't run - it says it can't find the old dates. How can I

> > > update 

> > > both the headings and the data in the report to reflect the new

> data

> > > in 

> > > the query?

> > > Richard Taylor



> > > I'm sorry if I'm missing something in your reply, but where can I

> read 

> some code to fix the problem, especially if the code is extensive?

> Richard Taylor.

> ---





=====

Visit www.alef.gr, greek science fiction, interactive site.



Entropy is increasing faster by burning books (Manolas M.)



__________________________________________________

Do You Yahoo!?

Get email at your own domain with Yahoo! Mail. 

http://personal.mail.yahoo.com/