Crystal Reports 8.5 automatic runtime report creation and data insertion (Web or VB6).
Author: Matt Burnett
Rating:
Visits: 14323
Discuss in Newsgroups
This function is fantastic with crystal reports. It takes 2 parameters, the crystal app object, and a recordset. It returns a report object that can be veiwed or printed. It does not require a existing report format (.rpt file) or data file (.ttx). The function can be used in VBScript or VB6.
I made some assumptions at the top to allow groups to be added and different saveAs paths, but essentially its all dynamic crystal 8.5. If you need subreports email me at burnettm@hotmail.com
The code below is VBScript, to use in VB, modify the following lines:
'////// ADD ADO RECORDSET TO THE NEW REPORT ///
Add: Set oRs = new ADODB.Recordset
Set Session("oRs") = adoMainRS
Modify: Set oRs = adoMainRs
Call Database.Tables.Add("",,Session("oRs"),,"P2smon.dll")
Modify: Call Database.Tables.Add("",,oRs,,"P2smon.dll")
Public Function getSimpleDynamicCRPT(byRef oApp, byVal adoMainRs)
'==============================================================================
' WORKING WITH THE REPORT DESIGNER COMPONENT AND ASP TO DYNAMICALLY CREATE A REPORT,
' ADD A RECORDSET, ADD GROUPS, AND ADD SECTIONS
'
'THIS REPORT AS NO SUBREPORT, ITS IS A SIMPLE REPORT
'==============================================================================
'This file uses a Crystal Application Object to create a New Report Object.
'Set session("oApp") = Server.CreateObject("CrystalRuntime.Application")
'
'The new reports data is contained in the ADO recordsets passed into this function.
'The ADO recordset also contains 'Formating Fields' information regarding:
' SysID, SortOrder
' blnUseExistingReport = true/false, if true, then we are in the incorrect function
' blnSaveReport = true/false
' blnReplaceExistingReport = true/false
' rptPath = "" Original path
' rptName = "" Original name
' rptSavePath = "" New path to save a report but not replace the original
' rptDisplayTitle = "" Report Title
' rptGroupFieldOrdinalReferences = "" 'A coma delimited string of integers that represent
' the Ordinal references of the data fields to be grouped
'Formating value are repeating on all rows of the rs. A consideration may be given to passing
'another rs into the function which contains the formating fields.
'
'GENERAL EXECUTION
'
'DEFINING THE FORMAT
'The design of this function is based around the adoMainRs recordset and results in a HORIZONTAL
'split of the recordset into 2 parts. The LEFT side contains 'Formating' fields list above.
'The RIGHT side contain fields to be displayed into the report. It is assumed that once development is finished
'The Ordine Reference of the 1st Data Field would be constant (with above format fields, its 9).
'The variable 'intStart_Position' should be set to Ordine Reference of the 1st Data Field.
'NOTE: All inserted values are set in the 'Define the format' code section immediately following the declarations.
'NOTE: Height, font, color, size, bold and alignment are pre-set conditions of a generic report.
'
'POSITIONING Crystal(object,left,top)
'The HORIZONTAL LEFT positioning used is based on the number of data fields to be displayed. Currently, adoMainRs
'has 2 (sysid, sortorder) fields not used for data, therefore, the intStart_Position is 3 (hardcoded).
'The TOP to Bottom positioning is relative to the top of the rtp.SECTION in which the object is placed.
'
'To create a positioning system based on coordinates inputed in a recordset.
'the adoMainRs would contain LEFT and TOP coordinates in twips (inches can be convert to twips):
'adoMainRs (might look like this and 250 is as left as you can go, zero, 0 , will not print)
'| sysid | sortorder | datafield1 | fieldPositionLEFT1 | fieldPositionTOP1 | datafield2 | fieldPositionLEFT2 | fieldPositionTOP2 |
'| 22222 | 2 | matt | 250 (twips) | 250 | doug | 2000 | 250
'| 33333 | 2 | jim | 250 | 3000 | tom | 2000 | 3000
'
'The same loop might be used in the column headers and field objects to insert the Crystal Data.
'Example: note its STEPPING
' For i = intStart_Position to intNumber_Of_Columns STEP 3 'STEP 3 will use every 3 as data field.
' Set crxColHeader = crxHeadSection.AddTextObject(adoMainRS(i).Name, int(adoMainRS(i+1).value), int(adoMainRS(i+2).value))
'
'12240 twip width of 8 1/2 inches, the lenght is 15840 twips of 11 inches OR 1440 twips per inch.
'Variable blnAddGroupLine insures there is a line under the column heads regardless of groups added.
'Set the Crystal Object WIDTH property to the entire width of page to get the horizontal alignment correct.
'
'SECTIONS
'The default Crystal sections are referenced by KEY not INDEX. This insures that after GROUPS and SUBREPORTS are
'added the correct references can be obtained.
'
'GROUPS
'rs("rptGroupFieldOrdinalReference") contains a string of ordinal fields references representing the fields
'in the recordset to group the report data.
'The Section INDEX of 3 is a constant starting position for any groups added.
'If you have a date field as a group, this will error. Change the constant CRanyValue = 14 to a valid date constant
'like CRDay or CRMonth.
'Each GROUP has two parts of header and footer. The footer is located below the Detail section.
'
'SESSIONS
'In VB, set Session values of oApp, oRpt to variables with proper scope and there are no problems.
'In VB6 this Method - Call Database.Tables.Add("",,adoMainRS,,"P2smon.dll") - is used.
'If in ASP, this Method will generate a 'type missmatch' that can only be resolved by setting the
'recordset into a session object, then using the session variable as the parameter.
'Clearly a frustrating error.
'Set Session(oRs) = adoMainRS is not needed in VB.
'
'SAVING THE REPORT
'Save the report parameter constant, 2048 is Crystal 8 format.
'CRYSTAL OBJECTS: EXAMPLES
'Set crxSetInReport = crxHeadSection.AddTextObject(adoMainRS(i).Name, 7000, 0)
'Set crFieldObject = crSection.AddFieldObject("{ado." & adoMainRS(4).Name & "}",5000,0)
'Set crxSetInReport = crxReportFooter.AddTextObject(Session("oRpt").PrintDate, 250, 0)
'crxPageFooter.AddSpecialVarFieldObject(crSvtPageNumber, 10000, 0) 'top is not needed, 'constant is 7
'==============================================================================
'==============================================================================
Dim Database, Table1, intStart_Position, crxSetInReport, crFieldObject, intDataPositionOffset
Dim crxReportHeader, crxPageHeader, crxGroupHeader1, crxDetail, crxReportFooter, crxPageFooter
Dim intColumnPosition, intColumnSpacing, intPageWidth, i, intNumber_Of_Columns, strValue
Dim crSection1, crSection2, aryGroups, strGroups, blnSaveReport, intTop, iCount
Dim rptPath, rptName, rptDisplayTitle, blnReplaceExistingReport, rptSavePath, blnReportSubReport
Dim oRpt, oRs
Dim blnAddGroupLine
'////// DEFINE THE FORMAT /////////////////////
blnSaveReport = true 'from rs, blnSaveReport
blnReplaceExistingReport = true 'from rs, blnReplaceExistingReport
blnAddGroupLine = false 'indicates a separator line between group and detail
strGroups = "3,4" 'from rs, rptGroupFieldOrdinalReferences
rptPath = "e:\temp\" 'from rs
rptName = "newreport.rpt" 'from rs
rptSavePath = "e:\matt\" 'from rs
rptDisplayTitle = "Dynamic Report (Simple)" 'from rs
intStart_Position = 3 'ss a recordset constant
intPageWidth = 15000 '12240 is page width, but 15000 works better
intNumber_Of_Columns = adoMainRs.Fields.Count - 1
intColumnSpacing = intPageWidth/intNumber_Of_Columns
intColumnPosition = 250 'if rs positioning, then from rs.
aryGroups = Split(strGroups,",")
intTop = 250
iCount = 0
'////// CREATE THE NEW REPORT /////////////////
Set oRpt = oApp.NewReport
'////// ADD ADO RECORDSET TO THE NEW REPORT ///
Set Session("oRs") = adoMainRS
Set Database = oRpt.Database
Call Database.Tables.Add("",,Session("oRs"),,"P2smon.dll")
Set Table1 = Database.Tables.Item(1)
'////// CREATE THE SECTIONS ///////////////////
Set crxReportHeader = oRpt.Sections.Item("RH") 'Report Header
Set crxPageHeader = oRpt.Sections.Item("PH") 'Page Header
Set crxDetail = oRpt.Sections.Item("D") 'Detail
Set crxReportFooter = oRpt.Sections.Item("RF") 'Report Footer
crxReportFooter.PrintAtBottomOfPage = true
Set crxPageFooter = oRpt.Sections.Item("PF") 'Page Footer
crxPageFooter.PrintAtBottomOfPage = true
'////// PAGE TITLE ////////////////////////////
Set crxSetInReport = crxReportHeader.AddTextObject(rptDisplayTitle, 0, 250)
With crxSetInReport
.Height = 350
.Width = intPageWidth
.Font.Size = 18
.Font.Underline = false
.Font.Bold = true
.TextColor = vbBlack
.HorAlignment = 2
End With
'////// COLUMN HEADERS ////////////////////////
Set crxSetInReport = crxPageHeader.AddTextObject("Date: ", intColumnPosition, 250) 'top is not needed
With crxSetInReport
.Height = 225
.Width = 2000 'intColumnSpacing
.TextColor = vbBlack
.Font.Bold = true
End With
Set crxSetInReport = crxPageHeader.AddSpecialVarFieldObject(crSvtPrintDate, intColumnPosition + 750, 250) '4
With crxSetInReport
.Height = 225
.Width = 2000 'intColumnSpacing
.TextColor = vbBlack
.Font.Bold = true
End With
For i = intStart_Position to intNumber_Of_Columns
Set crxSetInReport = crxPageHeader.AddTextObject(adoMainRS(i).Name, intColumnPosition, 750)
With crxSetInReport
.Height = 225
.Width = intColumnSpacing
.TextColor = vbBlack
.Font.Bold = true
End With
intColumnPosition = intColumnPosition + intColumnSpacing
Next
intColumnPosition = 250 'Reset the postion
'////// ADD GROUPS ////////////////////////////
If (strGroups <> "") then
For i = 0 to UBound(aryGroups)
Call oRpt.AddGroup(i,Table1.Fields(int(aryGroups(i))),14,0)
Set crxGroupHeader1 = oRpt.Sections.Item(i+3)
Set crFieldObject = crxGroupHeader1.AddFieldObject("{ado." & adoMainRS(int(aryGroups(i))).Name & "}",intColumnPosition,250)
With crFieldObject
.Height = 200
.Width = 5000 '.Width = intColumnSpacing
.TextColor = vbBlack
.HorAlignment = 1
End With
intColumnPosition = intColumnPosition + intColumnSpacing
If Not blnAddGroupLine then
Set crxSetInReport = crxGroupHeader1.AddLineObject(0, 0, 12000, 0)
crxSetInReport.LineThickness = 5
End If
blnAddGroupLine = true
Next
End If
'////// FILL THE DETAIL SECTION ///////////////
For i = intStart_Position to intNumber_Of_Columns
If Not(getAryValue(i,aryGroups)) then
Set crFieldObject = crxDetail.AddFieldObject("{ado." & adoMainRS(i).Name & "}",intColumnPosition,250)
With crFieldObject
.Height = 200
.Width = intColumnSpacing
.TextColor = vbBlue
.HorAlignment = 1
End With
intColumnPosition = intColumnPosition + intColumnSpacing
If Not blnAddGroupLine then
Set crxSetInReport = crxDetail.AddLineObject(0, 0, 12000, 0)
crxSetInReport.LineThickness = 5
End If
blnAddGroupLine = true
End If
Next
'////// PAGE AND REPORT FOOTER ////////////////
Set crxSetInReport = crxPageFooter.AddSpecialVarFieldObject(crSvtPageNumber, 10000, 0)
'////// SAVE THE NEW REPORT ///////////////////
If (blnSaveReport And blnReplaceExistingReport) then
Call oRpt.SaveAs(rptPath & rptName,2048) 'Replace
ElseIf (blnSaveReport) then
Call oRpt.SaveAs(rptSavePath & rptName,2048) 'New RPT, same name, different path
End If
'////// END AND RETURN THE REPORT OBJECT //////
Set getSimpleDynamicCRPT = oRpt
End Function
Private Function getAryValue(ByVal strItemName, ByVal aryItems)
Dim q 'Assumes a single column array of values, returns true if strItemName is in the array.
getAryValue = false
For q = 0 To UBound(aryItems)
If (UCase(aryItems(q)) = UCase(strItemName)) Then
getAryValue = true
Exit For
End If
Next
End Function
Visit my guru profile
Visitor Comments
