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