Function GenerateRenderingOfInformationForSelectedFactGroup() 'Information rendering of report 'On Error Resume Next Dim fs As FileSystemObject Dim ts As TextStream Dim rs As DAO.Recordset Dim strOutputFile As String strOutputFile = GetSystemSetting("TEMPFiles") & "\Temp\BRLM-InfoSet-Rendering.html" 'Debug.Print strOutputFile Dim iField As Integer Set fs = New FileSystemObject Set ts = fs.CreateTextFile(strOutputFile) '#CCCCDD Gray '#FFAA66 Orange '#F4F090 Yellow '#4477DD Blue '#66DDEE Cyan '#2EA495 Green 'Trying to make this HTML 5 compliant ts.WriteLine ("<!DOCTYPE html>") ts.WriteLine ("<!-- Updated: " & Now() & " -->") ts.WriteLine ("<html lang='en'>") ts.WriteLine (" <head>") ts.WriteLine (" <title>Rendering</title>") ts.WriteLine (" <style>") ts.WriteLine (" body {font-size:8pt; font-family:Verdana, Arial; color:Black; background-color:White}") ts.WriteLine (" hr {size:1; width:100%; color:Black}") ts.WriteLine (" table {border-collapse:collapse; table-layout:fixed; word-wrap:break-word; background-color:white; }") ts.WriteLine (" td {font-size:8pt; border:2px solid white;}") ts.WriteLine (" .Header {font-size:7pt; font-weight:bold; background-color:#FFAA66; vertical-align:text-bottom}") '#FFAA66=Orange ts.WriteLine (" .Header2 {font-size:8pt; font-weight:bold; background-color:lime; vertical-align:text-bottom}") ts.WriteLine (" .Header3 {font-size:8pt; font-weight:bold; background-color:aqua; vertical-align:text-bottom}") ts.WriteLine (" .Row {font-size:8pt; font-weight:normal; background-color:#F7F7F7; vertical-align:text-top}") 'F7F7F7=off white ts.WriteLine (" .Row2 {font-size:8pt; font-weight:normal; background-color:silver; vertical-align:text-top}") ts.WriteLine (" .Footer {font-size:8pt; font-weight:normal; background-color:Wheat;}") ts.WriteLine (" h1 {font-size:16pt; font-weight:bold; text-align:left; margin:0em}") ts.WriteLine (" h3 {font-size:8pt; font-weight:bold; text-align:center; color:navy; margin-top:1em}") ts.WriteLine (" a:link {font-weight:normal; Text-decoration:none;}") ts.WriteLine (" a:visited {font-weight:normal; Text-decoration:none;}") ts.WriteLine (" a:hover {font-weight:normal; Text-decoration:underline; background-color:#FF9933;}") ts.WriteLine (" </style>") ts.WriteLine (" </head>") ts.WriteLine (" <body>") ts.WriteLine (" <h1>Rendering</h1>") ts.WriteLine (" <p style='visibility:hidden; margin:0em'>*</p>") ts.WriteLine (" <!-- Fact Group Title -->") ts.WriteLine (" <table id='FactGroupInfo'>") ts.WriteLine (" <tr>") ts.WriteLine (" <td class='Header2' colspan='2' style='width:900px; text-align:left'>Fact Group (Combination of Network and Table)</td>") ts.WriteLine (" </tr>") ts.WriteLine (" <tr>") ts.WriteLine (" <td class='Header3' style='width:75px; text-align:left; vertical-align:text-top'>Network:</td>") ts.WriteLine (" <td class='Row2' style='width:825px; text-align:left'>" & LookupNetworkDescription(GetSystemSetting("FactGroup_SelectedNetwork")) & " <span style='font-size:6pt; color:gray'>(" & GetSystemSetting("FactGroup_SelectedNetwork") & ")</span></td>") ts.WriteLine (" </tr>") ts.WriteLine (" <tr>") ts.WriteLine (" <td class='Header3' style='width:75px; text-align:left; vertical-align:text-top'>Table:</td>") ts.WriteLine (" <td class='Row2' style='width:825px; text-align:left'>" & LookupHypercubeLabel(GetSystemSetting("FactGroup_SelectedHypercube")) & " <span style='font-size:6pt; color:gray'>(" & GetSystemSetting("FactGroup_SelectedHypercube") & ")</span></td>") ts.WriteLine (" </tr>") ts.WriteLine (" </table>") ts.WriteLine (" <p style='visibility:hidden; margin:0em'>*</p>") ts.WriteLine (" <!-- Slicers -->") ts.WriteLine (" <table id='Slicers'>") 'ts.WriteLine (" <col width='400' />") 'ts.WriteLine (" <col width='500' />") ts.WriteLine (" <tr>") ts.WriteLine (" <td class='Header2' colspan='2' style='width:900px; text-align:left'>Slicers (applies to each fact value in each table cell)</td>") ts.WriteLine (" </tr>") Set rs = CurrentDb().OpenRecordset("SELECT * from FactGroup_Slicers") Do While Not rs.EOF ts.WriteLine (" <tr>") ts.WriteLine (" <td class='Header' style='width:400px; text-align:left'>" & Replace(rs!UseMeasureName, "ZZZZ", "-") & "</td>") ts.WriteLine (" <td class='Row2' style='width:500px; text-align:left'>" & rs!MeasureValue & "</td>") ts.WriteLine (" </tr>") rs.MoveNext Loop rs.Close Set rs = Nothing ts.WriteLine (" </table>") ts.WriteLine (" <p style='visibility:hidden; margin:0em'>*</p>") ts.WriteLine (" <table id='FactGroup'>") 'This entire section can be removed as this is obsolete when using HTML5 'For each column, set the column width 'Can do some fiddling to se this width, based on the longest fact value ' Set rs = CurrentDb().OpenRecordset("SELECT * from FactGroup_Columns") 'For the row label 'ts.WriteLine (" <col width='400' />") 'TO DO: Adjust coulmn width here by walking through the columns, figuring out the average column width ' Do While Not rs.EOF ' ' 'ts.WriteLine (" <col width='" & rs!ColumnWidth & "' />") ' ' rs.MoveNext ' Loop ' ' rs.Close ' Set rs = Nothing 'Column Headings 'THIS NEEDS TO BE ADJUSTED 'TO DEAL WITH MORE THAN ONE AXIS 'ROWS AND COLUMNS NEED TO BE ADJUSTED TO DEAL WITH INFORMTION MODEL PATTERNS 'Calculate the number of columns Set rs = CurrentDb().OpenRecordset("SELECT * from FactGroup_Columns") rs.MoveLast rs.MoveFirst Dim intTotalColumns As Integer intTotalColumns = rs.RecordCount ts.WriteLine (" <tr>") ts.WriteLine (" <td class='Row' style='width:400px; text-align:" & strAlign & "'><span style='visibility:hidden; margin:0em'>*</span></td>") ts.WriteLine (" <td class='Header' colspan='" & intTotalColumns & "' style='width:500px; text-align:center'>" & Replace(DLookup("UseFieldName", "FactGroup_Fields", "IsColumn = true"), "ZZZZ", "-") & "</td>") ts.WriteLine (" </tr>") ts.WriteLine (" <tr>") Set rs = CurrentDb().OpenRecordset("SELECT * from FactGroup_Columns") strAlign = "left" ts.WriteLine (" <td class='Header' style='text-align:" & strAlign & "'>" & DLookup("UseFieldName", "FactGroup_Fields", "IsRow = true") & "</td>") Do While Not rs.EOF strAlign = "center" ts.WriteLine (" <td class='Header' style='width:" & rs!ColumnWidth & "px; text-align:" & strAlign & "'>" & Replace(rs!ColumnLabel, "&", "&") & "</td>") rs.MoveNext Loop rs.Close Set rs = Nothing ts.WriteLine (" </tr>") 'End of column headings 'Rows Set rs = CurrentDb().OpenRecordset("SELECT * from FactGroup_RenderingInfo") Dim strFactValueToWrite As String Dim strColor As String Do While Not rs.EOF strColor = "black" If InStr(rs!Label, "[Axis]") Then strColor = "#666666" End If If InStr(rs!Label, "[Member]") Then strColor = "#666666" End If If InStr(rs!Label, "[Line Items]") Then strColor = "#666666" End If If InStr(rs!Label, "[Hierarchy]") Then strColor = "#666666" End If If InStr(rs!Label, "[Roll Forward]") Then strColor = "#666666" End If If InStr(rs!Label, "[Roll Up]") Then strColor = "#666666" End If If InStr(rs!Label, "[Adjustment]") Then strColor = "#666666" End If If InStr(rs!Label, "[Variance]") Then strColor = "#666666" End If If InStr(rs!Label, "[Grid]") Then strColor = "#666666" End If If InStr(rs!Label, "[Abstract]") Then strColor = "#666666" End If ts.WriteLine (" <tr>") 'THIS IS THE LABEL 'This is stuff to get the link to report elements detailed information working ' If Not IsNull(DLookup("ReportElementName", "ReportElements_Labels", "ReportElementLabel = '" & rs!Label & "'")) Then ' strReportElementName = DLookup("ReportElementName", "ReportElements_Labels", "ReportElementLabel = '" & rs!Label & "'") ' ' 'Debug.Print DLookup("Key", "ReportElements", "MemberName = '" & strReportElementName & "'") ' ' strOnClick = "onClick=" & Chr(34) & "window.open('RE_" & DLookup("Key", "ReportElements", "MemberName = '" & strReportElementName & "'") & "_ReportElement.html" & "','popup','width=1100,height=500,scrollbars=yes,resizable=no,toolbar=no,directories=no,location=no,menubar=no,status=no,left=0,top=0'); return false" & Chr(34) & "" ' ts.WriteLine (" <td class='Row' style='color:" & strColor & ";text-align:left;text-indent:-20px;padding-left:" & rs!Padding & "px '>" & "<a href='RE_" & DLookup("Key", "ReportElements", "MemberName = '" & strReportElementName & "'") & "_ReportElement.html" & "' target='_new' " & strOnClick & ">" & rs!Label & "</a>" & "</td>") ' Else ' ts.WriteLine (" <td class='Row' style='color:" & strColor & ";text-align:left;text-indent:-20px;padding-left:" & rs!Padding & "px '>" & rs!Label & "</td>") ' End If 'This is the OLD approach, without the link to the detail ts.WriteLine (" <td class='Row' style='color:" & strColor & ";text-align:left;text-indent:-20px;padding-left:" & rs!Padding & "px '>" & rs!Label & "</td>") 'Adjust by 3 for label (start a 1 rather than 0), Key, and Padding For iField = 3 To rs.Fields.Count - 1 strFactValueToWrite = "ERROR" strFactValueToWrite = rs.Fields(iField).Value 'If it is blank, then hide the cell If strFactValueToWrite = "BLANK" Then strFactValueToWrite = "<span style='visibility:hidden; margin:0em'>*</span>" End If 'if it is numeric, then right align it If IsNumeric(strFactValueToWrite) Then 'MsgBox strFactValueToWrite strAlign = "right" If InStr(1, strFactValueToWrite, ".") Then strFactValueToWrite = Format(strFactValueToWrite, "#,##0.0#\ ;(#,##0.0#)") Else strFactValueToWrite = Format(strFactValueToWrite, "#,##0\ ;(#,##0)") End If Else strAlign = "left" End If ts.WriteLine (" <td class='Row' style='text-align:" & strAlign & "'>" & Replace(strFactValueToWrite, "`", "'") & "</td>") Next iField ts.WriteLine (" </tr>") rs.MoveNext Loop rs.Close Set rs = Nothing ts.WriteLine (" </table>") ts.WriteLine (" </body>") ts.WriteLine ("</html>") Set rs = Nothing Set fs = Nothing Set ts = Nothing 'MsgBox "Done!" End Function