4
\$\begingroup\$

CellStyleCSS class creates css based of Excel Workbook CellStyles. This class is used in conjunction with TagBuilder class, which is, posted here: Creating HTML using a Builder Pattern

My main objective is to simulate a DataGridView and my focus is on generating HTML Tables using this class.

Please let me know if there are any improvements that I can make to the class, such as:

  • Functionality that needs to be generated to handle certain situations
  • Specific situations that need to be addressed
  • Improved naming of variables

Note: Because I cannot change the registry on the workstations that will use this project, I'm limited to using the Webbrowser Control in IE6 mode and CSS 1. I also tried using the X-UA-Compatible Meta header featured in Web Browser Control & Specifying the IE Version, to no avail.

enter image description here


Class: CellStyleCSS

Option Explicit

'Style Border Order: 1=xlEdgeBottom;2=xlEdgeTop;3=xlEdgeLeft;4=xlEdgeRight;5=xlDiagonalDown;6=xlDiagonalUp
'Css Border Order: top, right, bottom,left

Private Sub appendCSS_Border(sb As Object, Style1 As Style)
    Dim Item As Variant
    Dim borderStyles(1 To 4) As String, borderWidths(1 To 4) As String, borderColors(1 To 4) As String

    For Each Item In Array(2, 4, 1, 3)
        borderStyles(Item) = getBorderStyleCSSName(Style1.Borders(Item).LineStyle)
        borderWidths(Item) = getBorderWeightCSS(Style1.Borders(Item).Weight)
        borderColors(Item) = getRGB(Style1.Borders(Item).Color)
    Next

    If Len(Join(borderStyles, "")) > 0 Then sb.Append_3 "border-style:" & Join(borderStyles, " ") & ";"
    If Len(Join(borderWidths, "")) > 0 Then sb.Append_3 "border-width:" & Join(borderWidths, " ") & ";"
    If Len(Join(borderColors, "")) > 0 Then sb.Append_3 "border-color:" & Join(borderColors, " ") & ";"
End Sub

Private Sub appendCSS_Color(sb As Object, Style1 As Style)
    sb.Append_3 "color:" & getRGB(Style1.Font.Color) & ";"
End Sub

'font    Sets all the font properties in one declaration
'font: font-style font-variant font-weight font-size/line-height font-family|caption|icon|menu|message-box|small-caption|status-bar|initial|inherit;
'font: italic bold 12px/30px Georgia, serif;
'font-family: "Times New Roman", Times, serif;
'font-family Specifies the font family for text
'font-size   Specifies the font size of text
'font-style  Specifies the font style for text
'font-variant    Specifies whether or not a text should be displayed in a small-caps font
'font-weight Specifies the weight of a font

Private Sub appendCSS_Font(sb As Object, Style1 As Style)
    With Style1
        sb.Append_3 "Font:"
        With .Font
            If .Bold Then sb.Append_3 "Bold "
            If .Italic Then sb.Append_3 "Italic "
            sb.Append_3 .Size & "pt "
            sb.Append_3 .Name
            sb.Append_3 ";"
        End With
    End With
End Sub

'text-decoration: none|underline|overline|line-through|initial|inherit;
'none    Defines a normal text. This is default
'underline   Defines a line below the text
'overline    Defines a line above the text
'line-through    Defines a line through the text
'initial Sets this property to its default value. Read about initial
'inherit Inherits this property from its parent element. Read about inherit

Private Sub appendCSS_TextDecoration(sb As Object, Style1 As Style)
    With Style1
        With .Font
            If .Strikethrough Then
                sb.Append_3 "text-decoration:line-through;"
            ElseIf .Underline Then
                sb.Append_3 "text-decoration:underline;"
            End If
        End With
    End With
End Sub

Private Sub appendCSS_TextIndent(sb As Object, Style1 As Style)
    sb.Append_3 "text-indent:" & getRGB(Style1.IndentLevel) * 9 & "px;"
End Sub

'word-wrap: normal|break-word|initial|inherit;

Private Sub appendCSS_WordWrap(sb As Object, Style1 As Style)
    sb.Append_3 "word-wrap:" & IIf(Style1.WrapText, "break-word", "normal") & ";"
End Sub

Private Function getBorderStyleCSSName(BorderLineStyle As Variant) As String
'Border CSS Line Styles: dotted, dashed, solid, double, groove, ridge, inset, outset
    Select Case BorderLineStyle
        Case XlLineStyle.xlContinuous
            getBorderStyleCSSName = "solid"
        Case XlLineStyle.xlDash
            getBorderStyleCSSName = "dashed"
        Case XlLineStyle.xlDashDot
            getBorderStyleCSSName = "dashed"
        Case XlLineStyle.xlDashDotDot
            getBorderStyleCSSName = "dotted"
        Case XlLineStyle.xlDot
            getBorderStyleCSSName = "dotted"
        Case XlLineStyle.xlDouble
            getBorderStyleCSSName = "double"
        Case XlLineStyle.xlLineStyleNone
            getBorderStyleCSSName = ""
        Case XlLineStyle.xlSlantDashDot
            getBorderStyleCSSName = "ridge"
        Case Else
            getBorderStyleCSSName = "solid"
    End Select
End Function

Private Function getBorderWeightCSS(Weight As XlBorderWeight) As String
    getBorderWeightCSS = Switch(Weight = xlHairline, "0.4pt", Weight = xlMedium, "1.0pt", Weight = xlThick, "1.5pt", Weight = xlThin, "0.5pt", True, "")
End Function

' https://stackoverflow.com/questions/6003324/how-do-i-get-the-corresponding-hex-value-of-an-rgb-color-in-excel-vba

Function getRGB(ByVal Color As Long) As String
    Dim hexCode As String, hexColor As String, R As String, B As String, G As String

    If Color = vbGreen Then
        getRGB = "rgb(0, 255, 0)"
    ElseIf Color = vbRed Then
        getRGB = "rgb(255, 0, 0)"
    Else
        hexCode = Hex(Color)
        If Len(hexCode) <> 0 Then
            'Note the order excel uses for hex is BGR.
            R = Val("&H" & Mid(hexCode, 5, 2))
            B = Val("&H" & Mid(hexCode, 1, 2))
            G = Val("&H" & Mid(hexCode, 3, 2))
            getRGB = "rgb(" & R & ", " & G & ", " & B & ")"
        End If
    End If
End Function

Public Function ToString(Item As Variant) As String
    Dim sb As Object: Set sb = CreateObject("System.Text.StringBuilder")
    Dim Style1 As Style
    If IsNumeric(Item) Then
        Set Style1 = ThisWorkbook.Styles(Item)
    Else
        Set Style1 = ThisWorkbook.Styles(CStr(Item))
    End If

    With Style1
        If .IncludeFont Then
            appendCSS_Color sb, Style1
            appendCSS_Font sb, Style1
            appendCSS_TextDecoration sb, Style1
        End If
        appendCSS_WordWrap sb, Style1
        On Error Resume Next
        Call IsNull(.IndentLevel)
        If Err.Number = 0 Then appendCSS_TextIndent sb, Style1
        On Error GoTo 0

        If .IncludeBorder Then appendCSS_Border sb, Style1

        sb.Append_3 "Background:" & getRGB(Style1.Interior.Color) & ";"
    End With
    ToString = sb.ToString
End Function

Raw Output

Dim css As CellStyleCSS
Set css = New CellStyleCSS
Debug.Print css.ToString("Total")

color:rgb(0, 0, 0);Font:Bold 11pt Calibri;text-decoration:underline;word-wrap:normal;border-style:  solid double;border-width:0.5pt 0.5pt 0.5pt 1.5pt;border-color:rgb(0, 0, 0) rgb(0, 0, 0) rgb(79, 129, 189) rgb(79, 129, 189);Background:rgb(255, 255, 255);

The generated CSS can be used in the as an inline-style or in CSS StyleSheet. In the ↑ demo above ↑ the CSS in the is replaced.

Private Sub UpdateStyles()
    WebBrowser1.Document.styleSheets(0).cssText = getDocStyleCSS(TableID)
End Sub

Function getDocStyleCSS(TableID1 As String) As String
    Dim css As CellStyleCSS: Set css = New CellStyleCSS
    Dim sb As Object: Set sb = CreateObject("System.Text.StringBuilder")
    sb.Append_3 "#" & TableID1 & " THEAD TH{" & css.ToString(cboTH.Value) & "}"
    sb.Append_3 "#" & TableID1 & " .EVEN{" & css.ToString(cboEvenTR.Value) & "}"
    sb.Append_3 "#" & TableID1 & " .ODD{" & css.ToString(cboOddTR.Value) & "}"
    sb.Append_3 "#" & TableID1 & " .SELECTED TD{" & css.ToString(cboSelected.Value) & "}"
    sb.Append_3 "#" & TableID1 & " TD,TH{padding:5px;}"

    If ckCollapseBorders Then sb.Append_3 " TABLE{border-collapse:collapse;}"

    getDocStyleCSS = sb.ToString
End Function

Formatted Output

This is the css generated for the default table in the ↑ demo above ↑ formatted using CSS Beautifier.

#Table1 THEAD TH {
    color: rgb(255, 255, 255);
    Font: 11pt Calibri;
    text-decoration: underline;
    word-wrap: normal;
    Background: rgb(79, 129, 189);
}
#Table1 .EVEN {
    color: rgb(255, 255, 255);
    Font: 11pt Calibri;
    text-decoration: underline;
    word-wrap: normal;
    Background: rgb(149, 179, 215);
}
#Table1 .ODD {
    color: rgb(0, 0, 0);
    Font: 11pt Calibri;
    text-decoration: underline;
    word-wrap: normal;
    Background: rgb(219, 229, 241);
}
#Table1 .SELECTED TD {
    color: rgb(255, 255, 255);
    Font: 8pt Calibri;
    text-decoration: underline;
    word-wrap: break-word;
    border-width: 0.5pt 0.5pt 0.5pt 0.5pt;
    border-color: rgb(0, 0, 0) rgb(0, 0, 0) rgb(0, 0, 0) rgb(0, 0, 0);
    Background: rgb(255, 0, 0);
}
#Table1 TD,
TH {
    padding: 5px;
}

Addendum

Based on the OP's answer to vba webbrowser and external javascript loading, I managed to get JQuery and CSS3 working.

  • HTML needs to begin:
  • In the Head tag add
  • WebBrower1.Silent = True
  • WebBrower1.Refresh after you write or load the html
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy