'DEVELOPER'S NOTES:
' In order to produce the report using a crosstab type query, code has been developed that
' will determine the field names that will be created by the crosstab query that produces
' the data for the report and then modify the appropriate report, assigning the appropriate
' field names to the appropriate controls, making those controls visible and able to be
' populated based on the report selected in the "grpReportType" options group and if the
' "chkPcntChg" checkbox is checked
'reset the "strFldList" variable and the "cntr" and "varChrLoc" variables
strFldList = ""
cntr = 1
varChrLoc = 1
Select Case Me.grpReportType
Case 1 'Specify the report that is to be prepared
'get the list of fields expected
strFldList = GetListOfFieldNames("All RUs")
'assign the report name to the variable "strRptName"
If Me.chkPcntChg = True Then
If Me.chkTrendLines = True Then
strRptName = "rptTotalUsePerMonthByRU-All-PercentChg-WithSpark"
Else
strRptName = "rptTotalUsePerMonthByRU-All-PercentChg"
End If
Else
strRptName = "rptTotalUsePerMonthByRU-All"
End If
'open the report in design view that is to have the field names (controls source) assigned
DoCmd.OpenReport (strRptName), acViewDesign
ReadFieldNamesAllRpt:
varNxtChrLoc = InStr(varChrLoc, strFldList, ",")
'read the Field name
If varNxtChrLoc > 0 Then
strFldNames(cntr) = Mid(strFldList, varChrLoc, varNxtChrLoc - varChrLoc)
Else
strFldNames(cntr) = Mid(strFldList, varChrLoc, Len(strFldList))
End If
'assign the Control Source of the field control
With Reports(strRptName).Controls("txtFld" & cntr)
.ControlSource = strFldNames(cntr)
.Visible = True
End With
'set the caption for the label
With Reports(strRptName).Controls("lblFld" & cntr)
.Caption = strFldNames(cntr)
.Visible = True
End With
varChrLoc = varNxtChrLoc + 1
If varNxtChrLoc > 0 Then
cntr = cntr + 1
GoTo ReadFieldNamesAllRpt
End If
'Assign the query name to be used for exporting to Excel to the variable "strExportQueryName"
'Note: this is the same query that is used to produce the data for the report
strExportQueryName = "qryTotalUsePerMonthByRU_Crosstab"
Case 2 'configure the "rptTotalUsePerMonthByRU-Corp" or the "rptTotalUsePerMonthByRU-Corp-PercentChg" report
'get the list of fields expected
strFldList = GetListOfFieldNames("Only Corp")
'assign the report name to the variable "strRptName"
If Me.chkPcntChg = True Then
If Me.chkTrendLines = True Then
strRptName = "rptTotalUsePerMonthByRU-Corp-PercentChg-WithSpark"
Else
strRptName = "rptTotalUsePerMonthByRU-Corp-PercentChg"
End If
Else
strRptName = "rptTotalUsePerMonthByRU-Corp"
End If
'open the report in design view that is to have the field names (controls source) assigned
DoCmd.OpenReport (strRptName), acViewDesign
ReadFieldNamesCorp:
varNxtChrLoc = InStr(varChrLoc, strFldList, ",")
'read the Field name
If varNxtChrLoc > 0 Then
strFldNames(cntr) = Mid(strFldList, varChrLoc, varNxtChrLoc - varChrLoc)
Else
strFldNames(cntr) = Mid(strFldList, varChrLoc, Len(strFldList))
End If
'assign the Control Source of the first field control
With Reports(strRptName).Controls("txtFld" & cntr)
.ControlSource = strFldNames(cntr)
.Visible = True
End With
'set the caption for the first field
With Reports(strRptName).Controls("lblFld" & cntr)
.Caption = strFldNames(cntr)
.Visible = True
End With
varChrLoc = varNxtChrLoc + 1
If varNxtChrLoc > 0 Then
cntr = cntr + 1
GoTo ReadFieldNamesCorp
End If
'Assign the query name to be used for exporting to Excel to the variable "strExportQueryName"
'Note: this is the same query that is used to produce the data for the report
strExportQueryName = "qryTotalUsePerMonthByRU-Corp_Crosstab"
Case 3 'configure the "rptTotalUsePerMonthByRU-Retail" or the "rptTotalUsePerMonthByRU-Retail-PercentChg" report
'get the list of fields expected
strFldList = GetListOfFieldNames("Only Retail")
'assign the report name to the variable "strRptName"
If Me.chkPcntChg = True Then
If Me.chkTrendLines = True Then
strRptName = "rptTotalUsePerMonthByRU-Retail-PercentChg-WithSpark"
Else
strRptName = "rptTotalUsePerMonthByRU-Retail-PercentChg"
End If
Else
strRptName = "rptTotalUsePerMonthByRU-Retail"
End If
'open the report in design view that is to have the field names (controls source) assigned
DoCmd.OpenReport (strRptName), acViewDesign
ReadFieldNamesAllRetail:
varNxtChrLoc = InStr(varChrLoc, strFldList, ",")
'read the Field name
If varNxtChrLoc > 0 Then
strFldNames(cntr) = Mid(strFldList, varChrLoc, varNxtChrLoc - varChrLoc)
Else
strFldNames(cntr) = Mid(strFldList, varChrLoc, Len(strFldList))
End If
'assign the Control Source of the first field control
With Reports(strRptName).Controls("txtFld" & cntr)
.ControlSource = strFldNames(cntr)
.Visible = True
End With
'set the caption for the first field
With Reports(strRptName).Controls("lblFld" & cntr)
.Caption = strFldNames(cntr)
.Visible = True
End With
varChrLoc = varNxtChrLoc + 1
If varNxtChrLoc > 0 Then
cntr = cntr + 1
GoTo ReadFieldNamesAllRetail
End If
'Assign the query name to be used for exporting to Excel to the variable "strExportQueryName"
'Note: this is the same query that is used to produce the data for the report
strExportQueryName = "qryTotalUsePerMonthByRU-Retail_Crosstab"
End Select
'assign the last reporting Month and Year to the variable "strRptMoYr"
'this value will be used in the naming of the Excel and PDF output files
strRptMoYr = Replace(strFldNames(cntr), "/", "-")
'position the "Total RU Usage" label and "txtSumOfUsage" text box controls
'and the "Spark" label control based on
'the number of months being reported
Select Case cntr
Case 1
Reports(strRptName).Controls("txtSumOfUsage").Left = 3359.952
Reports(strRptName).Controls("lblTotalUse").Left = 3359.952
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 4560.048
End If
Case 2
Reports(strRptName).Controls("txtSumOfUsage").Left = 4320
Reports(strRptName).Controls("lblTotalUse").Left = 4320
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 5519.952
End If
Case 3
Reports(strRptName).Controls("txtSumOfUsage").Left = 5280.048
Reports(strRptName).Controls("lblTotalUse").Left = 5280.048
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 6480
End If
Case 4
Reports(strRptName).Controls("txtSumOfUsage").Left = 6239.952
Reports(strRptName).Controls("lblTotalUse").Left = 6239.952
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 7440.048
End If
Case 5
Reports(strRptName).Controls("txtSumOfUsage").Left = 7200
Reports(strRptName).Controls("lblTotalUse").Left = 7200
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 8399.952
End If
Case 6
Reports(strRptName).Controls("txtSumOfUsage").Left = 8160.048
Reports(strRptName).Controls("lblTotalUse").Left = 8160.048
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 9360
End If
Case 7
Reports(strRptName).Controls("txtSumOfUsage").Left = 9119.952
Reports(strRptName).Controls("lblTotalUse").Left = 9119.952
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 10320.048
End If
Case 8
Reports(strRptName).Controls("txtSumOfUsage").Left = 10080
Reports(strRptName).Controls("lblTotalUse").Left = 10080
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 11279.952
End If
Case 9
Reports(strRptName).Controls("txtSumOfUsage").Left = 11040.048
Reports(strRptName).Controls("lblTotalUse").Left = 11040.048
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 12240
End If
Case 10
Reports(strRptName).Controls("txtSumOfUsage").Left = 11999.952
Reports(strRptName).Controls("lblTotalUse").Left = 11999.952
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 13200.048
End If
Case 11
Reports(strRptName).Controls("txtSumOfUsage").Left = 12960
Reports(strRptName).Controls("lblTotalUse").Left = 12960
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 14159.952
End If
Case 12
Reports(strRptName).Controls("txtSumOfUsage").Left = 13920.048
Reports(strRptName).Controls("lblTotalUse").Left = 13920.048
If Me.chkTrendLines = True Then
Reports(strRptName).Controls("Spark").Left = 15120
End If
End Select
'close and save the changes to the report
DoCmd.Close acReport, strRptName, acSaveYes
'read the output path from the "tblAppInfo" table
strOutputPath = DLookup("OutputPath", "tblPersonalAppSettings")
Select Case Me.grpOutputOpts
Case 1 'Preview Report
DoCmd.OpenReport strRptName, acViewPreview
DoCmd.Maximize
If Me.chkTrendLines = True Then
DoCmd.RunCommand acCmdZoom75
Else
DoCmd.RunCommand acCmdZoom100
End If
Case 2 'Send to printer
DoCmd.OpenReport strRptName, acViewNormal
Case 3 'Export to Excel
'check to be sure that the path to the "output" location exists
If fIsFileDIR(strOutputName, vbDirectory) = -1 Then
strMsg = "The folder currently defined as the ""Output"" loacation where the Excel files " _
& "should be save to could not be found." & vbNewLine & vbNewLine & "Please update " _
& "this path using the ""Manage file Paths"" option from the ""Admin Options Menu""."
MsgBox strMsg, vbCritical + vbOKOnly, "Folder for Output Files Not Found"
Exit Sub
End If
'assign only the name for the output file - the extension will be added in the "Case" statement
strOutputName = strRptMoYr & "-" & strExportQueryName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, strExportQueryName, strOutputPath & "\" & strOutputName & ".xlsx"
MsgBox "Data successfully exported to Excel." _
& vbNewLine & "The file can be found at:" _
& vbNewLine & vbNewLine & strOutputPath & "\" & strOutputName & ".xlsx"
Case 4 'creat PDF
'check to be sure that the path to the "output" location exists
If fIsFileDIR(strOutputName, vbDirectory) = -1 Then
strMsg = "The folder currently defined as the ""Output"" loacation where the PDF documents " _
& "should be save to could not be found." & vbNewLine & vbNewLine & "Please update " _
& "this path using the ""Manage file Paths"" option from the ""Admin Options Menu""."
MsgBox strMsg, vbCritical + vbOKOnly, "Folder for Output Files Not Found"
Exit Sub
End If
strOutputName = strRptMoYr & "-" & Right(strRptName, Len(strRptName) - 3)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, strOutputPath & "\" & strOutputName & ".pdf", False
MsgBox "PDF document created successfully." _
& vbNewLine & "The file can be found at:" _
& vbNewLine & vbNewLine & strOutputPath & "\" & strOutputName & ".pdf"""
End Select
DoCmd.Echo True
DoCmd.Hourglass False
End Sub
Public Function GetListOfFieldNames(FilterType As String) As String
'the "FilterType" values expected would be the value of the Select Case statement below
'get the filter criteria for the rolling 12 months
strMaxMoYr = GetMaxMoYr
strStartMoYr = GetMoYrForRolling12MonthCriteria
Select Case FilterType
Case "All RUs"
'get the list of Month and Year values for only All LOBs
strSql = "SELECT DISTINCT tblTmpReportData.MoYr, tblTmpReportData.DataYear, " _
& "tblTmpReportData.DataMonth FROM tblTmpReportData " _
& "WHERE (((tblTmpReportData.MoYr) >= '" & strStartMoYr & "' " _
& "Or (tblTmpReportData.MoYr) <= '" & strMaxMoYr & "')) " _
& "ORDER BY tblTmpReportData.DataYear, tblTmpReportData.DataMonth;"
Case "Only Corp"
'get the list of Month and Year values for only Corp LOB
strSql = "SELECT DISTINCT tblTmpReportData.MoYr, tblTmpReportData.DataYear, " _
& "tblTmpReportData.DataMonth FROM tblTmpReportData " _
& "WHERE (((tblTmpReportData.MoYr)>='" & strStartMoYr & "' " _
& "Or (tblTmpReportData.MoYr)<='" & strMaxMoYr & "') " _
& "AND ((tblTmpReportData.LineOfBusinessID)=1)) " _
& "ORDER BY tblTmpReportData.DataYear, tblTmpReportData.DataMonth;"
Case "Only Retail"
'get the list of Month and Year values for only Retail LOB
strSql = "SELECT DISTINCT tblTmpReportData.MoYr, tblTmpReportData.DataYear, " _
& "tblTmpReportData.DataMonth FROM tblTmpReportData " _
& "WHERE (((tblTmpReportData.MoYr)>='" & strStartMoYr & "' " _
& "Or (tblTmpReportData.MoYr)<='" & strMaxMoYr & "') " _
& "AND ((tblTmpReportData.LineOfBusinessID)=5)) " _
& "ORDER BY tblTmpReportData.DataYear, tblTmpReportData.DataMonth;"
Case "All Servers"
'get the list of Month and Year values for top 25 percent change in All server tape
strSql = "SELECT DISTINCT [tblTapeServerDetails]![DataMonth] & ""/"" & " _
& "[tblTapeServerDetails]![DataYear] AS MoYr, tblTapeServerDetails.DataYear, " _
& "tblTapeServerDetails.DataMonth FROM qrySvrTapePercentChangeOver12Months " _
& "INNER JOIN (tblTapeServers INNER JOIN tblTapeServerDetails ON " _
& "tblTapeServers.TapeServerID = tblTapeServerDetails.TapeServerID) ON " _
& "qrySvrTapePercentChangeOver12Months.Server = tblTapeServers.Server " _
& "ORDER BY tblTapeServerDetails.DataYear DESC , tblTapeServerDetails.DataMonth;"
Case "Only Corp Servers"
'get the list of Month and Year values for top 25 percent change in Only Corp server tape
strSql = "SELECT DISTINCT [tblTapeServerDetails]![DataMonth] & ""/"" & " _
& "[tblTapeServerDetails]![DataYear] AS MoYr, tblTapeServerDetails.DataYear, " _
& "tblTapeServerDetails.DataMonth FROM qrySvrTapePercentChangeOver12Months " _
& "INNER JOIN (tblTapeServers INNER JOIN tblTapeServerDetails ON " _
& "tblTapeServers.TapeServerID = tblTapeServerDetails.TapeServerID) ON " _
& "qrySvrTapePercentChangeOver12Months.Server = tblTapeServers.Server " _
& "WHERE (((tblTapeServerDetails.LineOfBusinessID) = 1)) " _
& "ORDER BY tblTapeServerDetails.DataYear DESC , tblTapeServerDetails.DataMonth;"
Case "Only Retail Servers"
'get the list of Month and Year values for top 25 percent change in Only Retail server tape
strSql = "SELECT DISTINCT [tblTapeServerDetails]![DataMonth] & ""/"" & " _
& "[tblTapeServerDetails]![DataYear] AS MoYr, tblTapeServerDetails.DataYear, " _
& "tblTapeServerDetails.DataMonth FROM qrySvrTapePercentChangeOver12Months " _
& "INNER JOIN (tblTapeServers INNER JOIN tblTapeServerDetails ON " _
& "tblTapeServers.TapeServerID = tblTapeServerDetails.TapeServerID) ON " _
& "qrySvrTapePercentChangeOver12Months.Server = tblTapeServers.Server " _
& "WHERE (((tblTapeServerDetails.LineOfBusinessID) = 5)) " _
& "ORDER BY tblTapeServerDetails.DataYear DESC , tblTapeServerDetails.DataMonth;"
End Select
'reset the "strColNames" variable
strColNames = ""
Set rs = CurrentDb.OpenRecordset(strSql)
rs.MoveLast
rs.MoveFirst
varRecCnt = rs.RecordCount
For varRowCntr = 1 To varRecCnt
'read the month and Year value to a string
If strColNames = "" Then
strColNames = rs.Fields("MoYr").value
Else
strColNames = strColNames & "," & rs.Fields("MoYr").value
End If
rs.MoveNext
Next varRowCntr
GetListOfFieldNames = strColNames
End Function