On Feb 25, 6:02 am, Astley Le Jasper <Astley.lejas...@gmail.com> wrote:
> I have produced a form that takes these recordsets and prettifies them > by putting them in a form. I suppose I could also do the same in a > report.
> However, this assumes that you know which fields are coming your way.
> Does anyone have any suggestions or am I stuck with ugly tables Tables are neither ugly nor pretty.
You could learn to create forms and reports on the fly in code. One might think this would be slow. It is not.
example:
Option Compare Database Option Explicit
Const ReportName As String = "rptSchoolOrganizations" Const ReportCaption As String = "School Organizations" Const Spacing As Long = 57 Const StartField As Long = 6 Const Width As Long = 567
Private ClassStructure As ADODB.Recordset Private OrganizationType As String
Public Sub ViewSchoolOrganizationsReportofActualClasses() OrganizationType = "Actual" ShowStatusMessage "Updating Actual Grade Split-Grade Designations" UpDateGrade_SplitGradeDesignations ("tblActualClasses") ViewSchoolOrganizationsReport End Sub
Public Sub ViewSchoolOrganizationsReportofTheoreticalClasses() OrganizationType = "Theoretical" ShowStatusMessage "Updating Theoretical Grade Split-Grade Designations" UpDateGrade_SplitGradeDesignations ("tblTheoreticalClasses") ViewSchoolOrganizationsReport End Sub
Sub ViewSchoolOrganizationsReport()
Dim Control As Control Dim FieldName As String Dim Height As Long Dim Label As Label Dim Left As Long Dim Line As Line Dim NewReportName As String Dim NextTop As Long Dim SQL As String Dim Report As Report Dim TextBox As TextBox Dim ReportWidth As Long Dim z As Long
' ------------------------- ' if the report is open ' ask that it be closed ' and exit ' ------------------------- If SysCmd(acSysCmdGetObjectState, acForm, ReportName) <> 0 Then MsgBox "Please, close all reports and try again.", vbExclamation Or vbOKOnly, "FFDBA" GoTo ViewSchoolOrganizationsReportExit End If
' ------------------------- ' delete the report, is if exists ' ------------------------- On Error Resume Next DoCmd.DeleteObject acReport, ReportName On Error GoTo 0 ' ------------------------- ' set error handling ' ------------------------- ' On Error GoTo ViewSchoolOrganizationsReportErr
' ------------------------- ' stop screen updating ' ------------------------- Application.Echo 0
' ------------------------- ' get class structure ' ------------------------- GetClassStructure
' ------------------------- ' create the report ' ------------------------- ShowStatusMessage "Creating School Organization Report"
Set Report = Application.CreateReport With Report .Caption = "School Organizations" End With
' ------------------------- ' create groupings ' ------------------------- Application.CreateGroupLevel Report.Name, "fldSchoolName", True, True Application.CreateGroupLevel Report.Name, "fldProgramName", True, True With Report.GroupLevel(0) .KeepTogether = 1 End With With Report.GroupLevel(1) .KeepTogether = 1 End With
' ------------------------- ' create the textbox fields that access the data in the table ' ------------------------- With ClassStructure For z = StartField To .Fields.Count - 1 FieldName = .Fields(z).Name Set TextBox = Application.CreateReportControl(Report.Name, acTextBox, acDetail, , FieldName) With TextBox .Format = "#0;=#0;" & Chr$(34) & Chr$(34) .Left = Left .Name = "txt" & FieldName .TextAlign = 3 .Width = Width End With Left = Left + Width Next z End With
' ------------------------- ' set some report dimensions ' ------------------------- ReportWidth = Left Report.Width = ReportWidth Report.Section(acDetail).Height = TextBox.Height
' ------------------------- ' design the page header ' ------------------------- Set Line = Application.CreateReportControl( _ Report.Name, acLine, acPageHeader, , , 0, _ Spacing, ReportWidth) With Line .BorderWidth = 0 .Name = "Line1" NextTop = .Top + .Height + Spacing End With
Set Label = Application.CreateReportControl( _ Report.Name, acLabel, acPageHeader, , , 0, NextTop) With Label .BorderStyle = 0 .Caption = "Halton District School Board" .Name = "lblDistrictName" .SizeToFit .Width = ReportWidth NextTop = .Top + .Height + Spacing End With
Set Label = Application.CreateReportControl( _ Report.Name, acLabel, acPageHeader, , , 0, NextTop) With Label .BorderStyle = 0 .Caption = "School Organizations" .Name = "lblSchoolOrganizations" .SizeToFit .Width = ReportWidth NextTop = .Top + .Height + Spacing End With
Set Line = Application.CreateReportControl( _ Report.Name, acLine, acPageHeader, , , 0, _ NextTop, ReportWidth) With Line .BorderWidth = 0 .Name = "Line2" NextTop = .Top + .Height + Spacing End With
Report.Section(acPageHeader).Height = NextTop
' ------------------------- ' design the school grouping header ' ------------------------- Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel1Header, , , 0, _ Spacing, ReportWidth) With Line .BorderWidth = 3 .Name = "Line3" NextTop = .Top + .Height + Spacing End With
Set TextBox = Application.CreateReportControl( _ Report.Name, acTextBox, acGroupLevel1Header, , , 0, NextTop) With TextBox .BorderStyle = 0 .ControlSource = "fldSchoolName" .Name = "txtSchoolName" .SizeToFit .Width = ReportWidth NextTop = .Top + .Height + Spacing * 2 End With
Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel1Header, , , 0, _ NextTop, ReportWidth) With Line .BorderWidth = 3 .Name = "Line4" NextTop = .Top + .Height + Spacing End With
Report.Section(acGroupLevel1Header).Height = NextTop
' ------------------------- ' design the school grouping footer ' ------------------------- Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel1Footer, , , 0, _ Spacing, ReportWidth) With Line .BorderWidth = 3 .Name = "Line5" NextTop = .Top + .Height + Spacing End With
Set TextBox = Application.CreateReportControl( _ Report.Name, acTextBox, acGroupLevel1Footer, , , 0, NextTop) With TextBox .BorderStyle = 0 .ControlSource = "= fldSchoolName & " & Chr(34) & " Totals" & Chr(34) .Name = "txtSumSchool" .SizeToFit .Width = ReportWidth NextTop = .Top + .Height + Spacing End With
Left = 0
With ClassStructure For z = StartField To .Fields.Count - 1 FieldName = .Fields(z).Name Set TextBox = Application.CreateReportControl(Report.Name, acTextBox, acGroupLevel1Footer) With TextBox .ControlSource = "=Sum(" & FieldName & ")" .Left = Left .Name = "txt" & FieldName & "SumSchool" .TextAlign = 3 .Top = NextTop .Width = Width Height = .Top + .Height End With Left = Left + Width Next z End With
NextTop = Height + Spacing
Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel1Footer, , , 0, _ NextTop, ReportWidth) With Line .BorderWidth = 3 .Name = "Line6" NextTop = .Top + .Height + Spacing End With
Report.Section(acGroupLevel1Footer).Height = NextTop
' ------------------------- ' design the program grouping header ' ------------------------- Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel2Header, , , 0, _ Spacing, ReportWidth) With Line .BorderWidth = 0 .Name = "Line7" NextTop = .Top + .Height + Spacing End With
Set TextBox = Application.CreateReportControl( _ Report.Name, acTextBox, acGroupLevel2Header, , , 0, NextTop) With TextBox .BorderStyle = 0 .ControlSource = "fldProgramName" .Name = "txtProgramName" .SizeToFit .Width = ReportWidth NextTop = .Top + .Height + Spacing End With
Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel2Header, , , 0, _ NextTop, ReportWidth) With Line .BorderWidth = 0 .Name = "Line8" NextTop = .Top + .Height + Spacing End With
Left = 0 With ClassStructure For z = StartField To .Fields.Count - 1 FieldName = .Fields(z).Name Set Label = Application.CreateReportControl(Report.Name, acLabel, acGroupLevel2Header, , Replace(FieldName, "fld", "")) With Label .Left = Left .Name = "lbl" & .Caption .TextAlign = 3 .Top = NextTop .Width = Width Left = Left + Width End With Next z End With
Report.Section(acGroupLevel2Header).Height = Height
' ------------------------- ' design the program grouping footer ' ------------------------- Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel2Footer, , , 0, _ Spacing, ReportWidth) With Line .BorderWidth = 0 .Name = "Line9" NextTop = .Top + .Height + Spacing End With
Set TextBox = Application.CreateReportControl( _ Report.Name, acTextBox, acGroupLevel2Footer, , , 0, NextTop) With TextBox .BorderStyle = 0 .ControlSource = "= fldProgramName & " & Chr(34) & " Totals" & Chr(34) .Name = "txtSumProgram" .SizeToFit .Width = ReportWidth NextTop = .Top + .Height + Spacing End With
Left = 0
With ClassStructure For z = StartField To .Fields.Count - 1 FieldName = .Fields(z).Name Set TextBox = Application.CreateReportControl(Report.Name, acTextBox, acGroupLevel2Footer) With TextBox .ControlSource = "=Sum(" & FieldName & ")" .Left = Left .Name = "txt" & FieldName & "SumProgram" .TextAlign = 3 .Top = NextTop .Width = Width Height = .Top + .Height End With Left = Left + Width Next z End With
NextTop = Height + Spacing
Set Line = Application.CreateReportControl( _ Report.Name, acLine, acGroupLevel2Footer, , , 0, _ NextTop, ReportWidth) With Line .BorderWidth = 0 .Name = "Line10" NextTop = .Top + .Height + Spacing End With
Report.Section(acGroupLevel2Footer).Height = NextTop
' ------------------------- ' set page footer grouping properties ' ------------------------- Set TextBox = Application.CreateReportControl(Report.Name, acTextBox, acPageFooter, , , 0, Spacing * 2) With TextBox .ControlSource = "= " & Chr$(34) & "Page " & Chr$(34) & " & [Page] & " & Chr$(34) & " of " & Chr$(34) & " & [Pages]" .Name = "txtPage" .TextAlign = 1 .Width = ReportWidth NextTop = .Top + .Height + Spacing End With Set TextBox = Application.CreateReportControl(Report.Name, acTextBox, acPageFooter, , , 0, NextTop + Spacing * 2) With TextBox .ControlSource = "= Now()" .Format = "YYYY-MM-DD HH:NN" .Name = "txtNow" .TextAlign = 1 .Width = ReportWidth NextTop = .Top + .Height + Spacing End With
' ------------------------- ' set some more report properties ' ------------------------- With Report .Section(acPageFooter).Height = NextTop .Caption = ReportCaption .ShortcutMenuBar = "Report Preview"
NewReportName = .Name SQL = "SELECT" SQL = SQL & vbTab SQL = SQL & "tc.*," SQL = SQL & vbTab SQL = SQL & "ts.fldSchoolName," SQL = SQL & vbTab SQL = SQL & "tp.fldProgramName" SQL = SQL & vbTab SQL = SQL & "FROM tbl" & OrganizationType & "Classes tc" SQL = SQL & vbTab SQL = SQL & "LEFT JOIN tblSchools ts on tc.fldSchoolID = ts.fldSchoolID" SQL = SQL & vbTab SQL = SQL & "LEFT JOIN tblPrograms tp on tc.fldProgramID = tp.fldProgramID" With Form_frmLogin.Login If .Collect(2) <> 0 Then SQL = SQL & vbTab SQL = SQL & "WHERE ts.fldSchoolID = " & .Collect(2) End If End With SQL = SQL & vbTab SQL = SQL & "ORDER BY ts.fldSchoolName, tp.fldProgramName, tc.fldSequence" CurrentProject.Connection.Execute "ALTER PROCEDURE dbo.SpSchoolOrganizationReport AS " & SQL .RecordSource = "dbo.SpSchoolOrganizationReport" .Width = ReportWidth End With
' ------------------------- ' close and save the report ' -------------------------
DoCmd.Close acReport, Report.Name, acSaveYes
' ------------------------- ' Rename the report ' ------------------------- DoCmd.Rename ReportName, acReport, NewReportName ' ------------------------- ' Release the recordset ' ------------------------- ReleaseClassStructure
' ------------------------- ' View the report ' ------------------------- Application.Echo 1 ShowStatusMessage ReportCaption With DoCmd .OpenReport ReportName, acViewPreview .ShowToolbar "Print Preview", acToolbarNo .Maximize End With Reports(ReportName).ZoomControl = 0
ViewSchoolOrganizationsReportExit: ShowStatusMessage Exit Sub ViewSchoolOrganizationsReportErr: MsgBox Err.Description, vbCritical, "Number " & Err.Number DoCmd.Close acReport, Report.Name, acSaveNo ReleaseClassStructure Application.Echo 1 Resume ViewSchoolOrganizationsReportExit End Sub
Private Sub GetClassStructure() If Not ClassStructure Is Nothing Then Exit Sub Set ClassStructure = CurrentProject.Connection.Execute("SELECT * FROM tbl" & OrganizationType & "Classes WHERE 1 = 2") Set ClassStructure.ActiveConnection = Nothing End Sub
Private Sub ReleaseClassStructure() With ClassStructure If .State And adStateOpen Then .Close End With Set ClassStructure = Nothing End Sub
|