"The point is, ladies and gentlemen, that grids are good, grids clarify, cut through and capture the essence of a cool user experience. Grids, in all of their forms, grids on spreadsheets, grids on street plans, grids on web pages have marked the upward surge in humankind and CSS Grids, you mark my words, will save the malfunctioning specification called HTML." - Not Gordon Gecko
Introduction
Before Excel there was Lotus 1-2-3 which was launched in 1983; seven years later in 1990 Sir Tim Berners Lee invented HTML but sadly missed basing the document layout on a grid despite the success of spreadsheets. However he did give us HTML tables and these were grids but then the powers that be told us to stop using tables for page structure and instead use CSS features called "floats". For me this was a wrong turn.
Microsoft's Windows Presentation Foundation (WPF) introduced a grid structure and so was (in opinion) a better technology for laying-out a user interface. It looks like some people in the HTML/CSS world, for example Rachel Andrew, saw WPF and decided to copy it. Good for them. CSS Grids is obviously the right answer and now I can now recommend to any client to build their GUI in HTML and not WPF.
But then comes the issue of tooling and I can't help feeling that the Excel cell grid is a good place to model the HTML interface and we can write some VBA code to convert it to HTML and CSS and that is what the code in this post does.
Thankfully, the way CSS Grids works turns out to be quite simple. See the links at the bottom for CSS Grids documentation.
The set up
So the VBA code below is best saved to its own workbook which I have called ExcelGridToCssGridByColor.xlsm. I found keeping the code separate from the layout data to be invaluable whilst I tracked down some hard bugs. An earlier iteration used names but this was troublesome and so I switched to using colors to denote the regions of a grid.
Next, I added a new workbook which contains only layout data and no code, I called mine CssGridLayoutsColors1.xlsx. In it I have three layout sheets but I started with one to begin with, called Default. On this Default sheet I define a stack of colored cells with identifiers which will be used for CSS identifers. The Default sheet looks like the leftmost screenshot below. It is meant to represent the layout for the smallest possible screen and this is why it is a single column of cells. The height of the rows is respected in the HTML (as is the column widths) so feel free to adjust the row heights.
Then, I cloned the Default sheet twice and renamed them min-width-500 and min-width-700 which forms the media query that drives the responsive web design that allows the page to take advantage of more screen real estate. On the these two new sheets and I gave myself two columns and three columns respectively and I moved the regions around. The cells on these extra sheets can contain whatever text you want, i.e. they don't have to be identifiers like the Default sheet. The final sheet contains the text that will reach the markup.
The three sheets should look like the following screen shot...
The code's output is both to the immediate window but also to a file; I called mine N:\CssGrids.html but you can change the filename in the first subroutine of code. The output file is HTML and CSS and a rendering is shown on the left below. The best browser to use for CSS Grids is Firefox because it has a Grid developer tool shown on the right in the screenshot below and this is why the page shot on the left is annotated with the grid lines and grid area names.
If you play with the browser window's width then you'll see it respond to narrowest widths with a single column and the widest widths with three columns. Hence you now have responsive web design and all this is achieved without using Bootstrap and its twelve columns (incidentally you can replicate that if you want, see the docs).
The Html file
Here is the output of HTML and CSS. Please see links below to the documentation to understand it.
<html>
<head>
<style>
.clssite {
display: grid;
grid-template-columns: 135fr;
grid-template-rows: 28fr 28fr 87fr 15fr 15fr;
grid-template-areas: "masthead"
"page_title"
"main_content"
"sidebar"
"footer"
;
}
.clsfooter {
grid-area: footer;
}
.clsmain_content {
grid-area: main_content;
}
.clsmasthead {
grid-area: masthead;
}
.clspage_title {
grid-area: page_title;
}
.clssidebar {
grid-area: sidebar;
}
@media (min-width: 500px) {
.clssite {
display: grid;
grid-template-columns: 83fr 83fr;
grid-template-rows: 28fr 28fr 87fr 15fr;
grid-template-areas: "page_title page_title"
"main_content masthead"
"main_content sidebar"
"footer footer"
;
}
}
@media (min-width: 700px) {
.clssite {
display: grid;
grid-template-columns: 96fr 48fr 48fr;
grid-template-rows: 28fr 28fr 87fr;
grid-template-areas: "page_title page_title page_title"
"main_content masthead masthead"
"main_content sidebar footer"
;
}
}
</style>
</head>
<body>
<div class="clssite">
<div class="clsfooter">footer</div>
<div class="clsmain_content">main_content</div>
<div class="clsmasthead">masthead</div>
<div class="clspage_title">page_title</div>
<div class="clssidebar">sidebar</div>
</div>
</body>
</html>The VBA code
So finally here is the VBA code, you will need a Tools->Reference to Microsoft Scripting Runtime.
Option Explicit
'* Tools->References
'* Microsoft Scripting Runtime
Private mdicLines As New Scripting.Dictionary
Private Const csMinWidth As String = "min-width-"
Private Const csAnchorCellAddress As String = "B3"
Sub Test()
Dim wb As Excel.Workbook
Set wb = Application.Workbooks.Item("CssGridLayoutsColors1.xlsx")
With wb.Worksheets
Dim wsDefault As Excel.Worksheet
Set wsDefault = .Item("Default")
Dim ashtLayoutSheets As Variant
ashtLayoutSheets = Array(wsDefault, .Item("min-width-500"), .Item("min-width-700"))
End With
Dim dicKeyColors As Scripting.Dictionary
Set dicKeyColors = ReadKeyColors(wsDefault)
WriteCssGrid ashtLayoutSheets, dicKeyColors
WriteToFile "N:\CssGrids.html"
End Sub
Function ReadKeyColors(ByVal wsDefault As Excel.Worksheet) As Scripting.Dictionary
Dim rngColorKey As Excel.Range
Set rngColorKey = wsDefault.Range(csAnchorCellAddress).CurrentRegion
Dim dicKeyColors As Scripting.Dictionary
Set dicKeyColors = New Scripting.Dictionary
Dim rngLoop As Excel.Range
For Each rngLoop In rngColorKey
Dim sColorName As String
sColorName = rngLoop.Value
If InStr(1, sColorName, " ", vbBinaryCompare) > 0 Then
Err.Raise vbObjectError, "", "Input Error: Default sheet has cell content with spaces." & vbNewLine & _
"Please omit spaces as content here defines identifiers in the HTML/CSS."
End If
Dim lColor As Long
lColor = rngLoop.Interior.Color
If LenB(sColorName) > 0 Then
If Not dicKeyColors.Exists(lColor) Then
dicKeyColors.Add lColor, sColorName
Else
Err.Raise vbObjectError, "", "Key colors are not unique"
End If
End If
Next
Set ReadKeyColors = dicKeyColors
End Function
Sub WriteCssGrid(ByRef ashtLayoutSheets As Variant, ByVal dicKeyColors As Scripting.Dictionary)
Call ValidateInputParameters(ashtLayoutSheets)
Set mdicLines = Nothing '* reset the output buffer
WL "<html>"
WL "<head>"
WL "<style>"
Dim vLoop As Variant
For Each vLoop In ashtLayoutSheets
Dim wsLoop As Excel.Worksheet
Set wsLoop = vLoop
Call WriteCSSForGridSite(wsLoop, dicKeyColors)
Next
WL "</style>"
WL "</head>"
WL "<body>"
Call WriteHtmlForGridSite(ashtLayoutSheets(UBound(ashtLayoutSheets)), dicKeyColors)
WL "</body>"
WL "</html>"
Debug.Print VBA.Join(mdicLines.Items, vbNewLine)
End Sub
Sub WriteCSSForGridSite(ByVal wsLoop As Excel.Worksheet, ByVal dicKeyColors As Scripting.Dictionary)
Dim lMinWidth As Long
If wsLoop.Name = "Default" Then
lMinWidth = 0
Else
lMinWidth = CLng(Mid$(wsLoop.Name, Len(csMinWidth) + 1))
End If
Dim bMediaQuery As Boolean
bMediaQuery = (lMinWidth > 0)
Dim rngSite As Excel.Range
Set rngSite = wsLoop.Range(csAnchorCellAddress).CurrentRegion
Dim sIndent As String
sIndent = VBA.IIf(bMediaQuery, " ", "")
Dim dicRegions As Scripting.Dictionary
Dim sAreas As String
sAreas = DetermineRegionsByColor(wsLoop, dicKeyColors, lMinWidth, dicRegions)
If bMediaQuery Then WL "@media (min-width: " & lMinWidth & "px) {"
WL sIndent & ".clsSite {"
WL sIndent & " display: grid;"
WL sIndent & " grid-template-columns: " & siteColumnsOrRows(rngSite, XlRowCol.xlColumns) & ";"
WL sIndent & " grid-template-rows: " & siteColumnsOrRows(rngSite, XlRowCol.xlRows) & ";"
WL sIndent & " grid-template-areas: " & sAreas & ";"
WL sIndent & "}"
If bMediaQuery Then WL "}"
WL ""
Dim wb As Excel.Workbook
Set wb = rngSite.Worksheet.Parent
If Not bMediaQuery Then
Dim vRegion As Variant
For Each vRegion In dicKeyColors.Items
WL ".cls" & vRegion & " {"
WL " grid-area: " & vRegion & ";"
WL "}"
WL ""
Next
End If
End Sub
Function siteColumnsOrRows(ByVal rngSite As Excel.Range, ByVal eRowcol As XlRowCol) As String
Dim sReturn As String
If eRowcol = xlRows Then
Dim rngRowLoop As Excel.Range
For Each rngRowLoop In rngSite.Rows
Dim lRowHeight As Long
lRowHeight = rngRowLoop.Height
sReturn = sReturn & " " & CStr(lRowHeight) & "fr"
Next
End If
If eRowcol = xlColumns Then
Dim rngColumnLoop As Excel.Range
For Each rngColumnLoop In rngSite.Columns
Dim lColumnWidth As Long
lColumnWidth = rngColumnLoop.Width
sReturn = sReturn & " " & CStr(lColumnWidth) & "fr"
Next
End If
siteColumnsOrRows = sReturn
End Function
Function DetermineRegionsByColor(ByVal ws As Excel.Worksheet, _
ByVal dicKeyColors As Scripting.Dictionary, ByVal lMinWidth As Long, _
ByRef pdicRegions As Scripting.Dictionary) As String
Dim rngAnchor As Excel.Range
Set rngAnchor = ws.Range(csAnchorCellAddress)
Dim rngCurrentRegion As Excel.Range
Set rngCurrentRegion = rngAnchor.CurrentRegion
Dim sReturn As String
sReturn = ""
Set pdicRegions = New Scripting.Dictionary
Dim rngRowLoop As Excel.Range
For Each rngRowLoop In rngCurrentRegion.Rows
Dim sRow As String: sRow = """"
Dim rngLoop As Excel.Range
For Each rngLoop In rngRowLoop.Cells
Dim sRegion As String
sRegion = "."
If dicKeyColors.Exists(rngLoop.Interior.Color) Then
sRegion = dicKeyColors.Item(rngLoop.Interior.Color)
If pdicRegions.Exists(sRegion) Then
Dim rngUnion As Excel.Range
Set rngUnion = Application.Union(rngLoop, pdicRegions.Item(sRegion))
If rngUnion.Areas.Count > 1 Then
Err.Raise vbObjectError, "", "Error: Non-contiguous color block detected at cell " & ws.Name & "!" & rngLoop.Address
Else
Set pdicRegions.Item(sRegion) = rngUnion
End If
Else
pdicRegions.Add sRegion, rngLoop
End If
End If
sRow = sRow & sRegion & " "
Next
sRow = Trim(sRow) & """"
sReturn = sReturn & sRow & vbNewLine & Space$(VBA.IIf(lMinWidth = 0, 23, 25))
Next
DetermineRegionsByColor = sReturn
End Function
Sub WriteHtmlForGridSite(ByVal ws As Excel.Worksheet, ByVal dicKeyColors As Scripting.Dictionary)
Dim dicRegions As Scripting.Dictionary
DetermineRegionsByColor ws, dicKeyColors, 0, dicRegions
WL "<div class=""clssite"">"
Dim wb As Excel.Workbook
Set wb = ws.Parent
Dim vRegionLoop As Variant
For Each vRegionLoop In dicRegions
Dim rngRegion As Excel.Range
Set rngRegion = dicRegions.Item(vRegionLoop)
Dim vRangeValues As Variant
vRangeValues = rngRegion.Value
Dim sRangeValues As String: sRangeValues = ""
If IsEmpty(vRangeValues) Then
sRangeValues = ""
ElseIf IsArray(vRangeValues) Then
Dim vLoop As Variant
For Each vLoop In vRangeValues
sRangeValues = sRangeValues & CStr(vLoop)
Next vLoop
Else
sRangeValues = CStr(vRangeValues)
End If
WL "<div class=""cls" & vRegionLoop & """>" & sRangeValues & "</div>"
Next
WL "</div>"
End Sub
Sub WL(sLineToWrite As String)
mdicLines.Add mdicLines.Count, sLineToWrite
End Sub
Sub WriteToFile(ByVal sFileName As String)
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim txtOut As Scripting.TextStream
Set txtOut = fso.CreateTextFile(sFileName, True)
Dim vLine As Variant
For Each vLine In mdicLines.Items
txtOut.WriteLine vLine
Next
txtOut.Close
Set txtOut = Nothing
End Sub
Function ValidateInputParameters(ByRef ashtLayoutSheets As Variant)
Dim ws As Excel.Worksheet
Dim vLoop As Variant
Dim sErrMsg As String
Const csOneDim As String = "Input Error: ashtLayoutSheets should be a one-dimensional array" & _
" of at least 1 worksheet"
Const csNameConvention As String = _
"Input Error: ashtLayoutSheets contains worksheet '{ws.Name}' which breaks naming convention." & _
vbNewLine & "The sheet should be called either 'Default' or " & _
"begin with '" & csMinWidth & "' following by pixel number"
'* Ensure ashtLayoutSheets is an array
If Not IsArray(ashtLayoutSheets) Then Err.Raise vbObjectError, "", csOneDim
'* Ensure ashtLayoutSheets array is one-dimensional
Dim lLength As Long: lLength = -1
On Error Resume Next
lLength = UBound(ashtLayoutSheets) - LBound(ashtLayoutSheets) + 1
On Error GoTo 0
If lLength = -1 Then Err.Raise vbObjectError, "", csOneDim
'* Ensure all given worksheets conform to naming convention
For Each vLoop In ashtLayoutSheets
Set ws = vLoop
'* check the sheet is called either 'Default' or begins with 'min-width-'
If ws.Name = "Default" Then
'* fine, do nothing
ElseIf Left$(ws.Name, Len(csMinWidth)) = csMinWidth Then
'* check the remains are numeric
Dim sPixel As String
sPixel = Mid$(ws.Name, Len(csMinWidth) + 1)
If Not IsNumeric(sPixel) Then Err.Raise vbObjectError, "", Replace(csNameConvention, "{ws.Name}", ws.Name)
Else
Err.Raise vbObjectError, "", Replace(csNameConvention, "{ws.Name}", ws.Name)
End If
Next
End Function
No comments:
Post a Comment