Excel VBA

HTML Color Chart

A number of people that sit around me need to see several colors on web pages at the same time to see which ones look best next to each other. And because every monitor affects the color in its own special way, a generated chart seemed to work best. This quick and dirty macro did exactly what we needed and only took 30 minutes to write (then I tweaked and made pretty for a couple days!). After I was all finished they said, “but how can I tell how it looks against my colored backgrounds?” See the chooser box on the right generated by the ‘ChoosertheSecond’ module.

This example displays the use of an array (ColChoice and DecChoice), and three nested For...Next statements, UBound and LBound. And a bunch of crazy stuff in HTML.

Option Explicit
Public ColChoice As Variant, ThrdTier, RowPos As Integer
Public BackCol, ForeColor, FirsTier, SecTier, f1STpACK, s2NDpACK, t3RDpACK, POS
Public firstDec, secDec, thirdDec, DecChoice, CompleteY, QuoTe As String
Public Input_Dir As String

Sub MakeHTMcolors()
    'Defining each digit of the six in 3 pairs for HTML colors Ex. #99FFCC
    ColChoice = Array("00", "33", "55", "66", "77", "99", "AA", "CC", "DD", "EE", "FF")
    DecChoice = Array("000", "051", "085", "102", "119", "153", "170", "204", "221", "238", "255")
    QuoTe = Chr(34)
    POS = 0
    Input_Dir = InputBox("Input the path where you want to put the " _
      & "Color Charts HTML" & Chr(13) & Chr(13) & _
       "i.e.:Windows- C:\EXCEL, H:\DATA\STUFF, J:\Asset Management", "Get Directory", _
       "C:\TEMP")

        If Input_Dir = "" Then Exit Sub
        If Right(Input_Dir, 1) = "\" Then
            Input_Dir = Input_Dir
        Else
            Input_Dir = Input_Dir & "\"
        End If
      
    Open Input_Dir & "ColorThing.htm" For Output As #1
    Print #1, "<HTML>"
    Print #1, "<HEAD>"
    Print #1, "<TITLE>HTML Color Chart</TITLE>"
    Print #1, "<style>"
    Print #1, "<!--"
    Print #1, "BODY { FONT-SIZE: small; FONT-FAMILY: Arial,sans serif; }"
    Print #1, "TD { FONT-SIZE: 9pt; }"
    Print #1, "-->"
    Print #1, "</style>"
    Print #1, "</HEAD>"
    Print #1, "<BODY>"
    Print #1, "<h1>Color Chart</h1>"
    Print #1, "<TABLE border=" & Chr(34) & "0" & Chr(34) & ">"
    'From lowest index value in Array to highest
    For ForeColor = LBound(ColChoice) To UBound(ColChoice) Step 1
    Print #1, "</TR>"
        FirsTier = ColChoice(ForeColor) 'Hex Value
        firstDec = DecChoice(ForeColor) 'Decimal Value
            For s2NDpACK = LBound(ColChoice) To UBound(ColChoice) Step 1
                SecTier = ColChoice(s2NDpACK)   '2nd Grouping
                secDec = DecChoice(s2NDpACK)
            Print #1, "<TD> <!-- inside table  -->"
            Print #1, "<TABLE border=" & Chr(34) & "0" & Chr(34) & _
                " cellpadding=" & QuoTe & "0" & QuoTe & " cellspacing=" _
                    & QuoTe & "1" & QuoTe & ">"
                    For t3RDpACK = LBound(ColChoice) To UBound(ColChoice) Step 1
                        ThrdTier = ColChoice(t3RDpACK)  '3rd Grouping
                        thirdDec = DecChoice(t3RDpACK)
                        CompleteY = FirsTier & SecTier & ThrdTier
                Select Case SecTier
                    'Color the font if color to light for contrast
                    Case "00", "11", "22", "33", "44", "55", "66", "77", "88", "99"
                        Print #1, "<TR><TD bgcolor=rgb(" & firstDec & "," & secDec & "," _
                            & thirdDec & ") align=center><B><FONT COLOR=" & Chr(34) _
                            & "#FFFFFF" & Chr(34) & "><nobr>" & FirsTier & SecTier & ThrdTier _
                            & "</nobr></B><BR>" & firstDec & "," & secDec & "," & thirdDec & "</FONT></TD></TR>"
                    Case Else
                        'Do not color background
                        Print #1, "<TR><TD bgcolor=rgb(" & firstDec & "," & secDec & "," _
                            & thirdDec & ") align=center><B>" & FirsTier _
                            & SecTier & ThrdTier & "</B><BR><nobr>" & firstDec & "," & secDec & "," _
                            & thirdDec & "</nobr></TD></TR>"
                End Select
        POS = POS + 1
                    Next    'Third Tier
            Print #1, "</TABLE></TD>"
            If CompleteY = "00FFFF" Then
                ChooserTheSecond    'Get the FORM and JavaScript
            End If
            Next        'Second Tier
    Next        '1st Tier
    Print #1, "</TR>"
    Print #1, "</TABLE>"
    Print #1, "<P>" & POS & " colors displayed on chart. "
    Print #1, "<P>Color selection chart generated from " & _
        ThisWorkbook.Path & "\" & ThisWorkbook.Name & " on " _
            & Application.Text(Now(), "dd mmmm, yyyy HH:mm:ss") & " using Excel vers. " _
            & Application.Version & ". See the <A HREF=http://www.barasch.com/excel/xlcolor.htm>Excel VBA</A> code?"
    Print #1, "<P>See also a similar chart with characters colored at " _
        & "<A HREF=colorfonts.htm>Characters</A>."
    Print #1, "</BODY></HTML>"
    Close #1
    MakeFontColor   'Call the Font Color macro
    MsgBox "Done with Fonts & Cells on " & Input_Dir, 64, "Make list..."
End Sub

Sub MakeFontColor()
    'Defining each digit of the six in 3 pairs for HTML colors Ex. #99FFCC
    ColChoice = Array("00", "33", "55", "66", "77", "99", _
        "AA", "CC", "DD", "EE", "FF")   'Hex Array
    DecChoice = Array("000", "051", "085", "102", "119", _
        "153", "170", "204", "221", "238", "255")   'Decimal Array

    POS = 0
    Open Input_Dir & "ColorFonts.htm" For Output As #1
    Print #1, "<HTML>" & vbCrLf & "<HEAD>"
    Print #1, "<TITLE>HTML Font Color Chart</TITLE>"
    Print #1, "<style>" 'Embedded Styles
    Print #1, "<!--"
    Print #1, "BODY { FONT-SIZE: small; FONT-FAMILY: Arial,sans serif; }"
    Print #1, "TD { FONT-SIZE: 9pt; }"
    Print #1, "-->"
    Print #1, "</style>" & vbCrLf & "</HEAD>"
    Print #1, "<BODY bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & ">"
    Print #1, "<h1>Font Color Chart</h1>"
    Print #1, "<TABLE border=" & Chr(34) & "0" & Chr(34) & ">"
    For ForeColor = LBound(ColChoice) To UBound(ColChoice) Step 1   'First value in array is zero
    Print #1, "</TR>"
        FirsTier = ColChoice(ForeColor)
        firstDec = DecChoice(ForeColor)
            For s2NDpACK = LBound(ColChoice) To UBound(ColChoice) Step 1
                SecTier = ColChoice(s2NDpACK)
                secDec = DecChoice(s2NDpACK)
            Print #1, "<TD> <!-- inside table  -->"
            Print #1, "<TABLE border=" & Chr(34) & "0" & Chr(34) & ">"
                    For t3RDpACK = LBound(ColChoice) To UBound(ColChoice) Step 1
                        ThrdTier = ColChoice(t3RDpACK)
                        thirdDec = DecChoice(t3RDpACK)
                        CompleteY = FirsTier & SecTier & ThrdTier
                    Print #1, "<TR><TD align=" & Chr(34) & "center" & Chr(34) & _
                        "><FONT COLOR=" & Chr(34) & FirsTier & SecTier _
                        & ThrdTier & Chr(34) & ">" & FirsTier & SecTier _
                        & ThrdTier & "<BR>" & firstDec & "," & secDec _
                        & "," & thirdDec & "</FONT></TD></TR>"
        POS = POS + 1
                    Next    'Third Tier
            Print #1, "</TABLE></TD>"
            If CompleteY = "00FFFF" Then
                ChooserTheSecond
            End If
            Next        'Second Tier
    Next        '1st Tier
    Print #1, "</TR>"
    Print #1, "</TABLE>"
    Print #1, "<P>" & POS & " colors displayed on chart. "
    Print #1, "<P>Color selection chart generated from " & _
        ThisWorkbook.Path & "\" & ThisWorkbook.Name & " on " _
            & Application.Text(Now(), "dd mmmm, yyyy HH:mm:ss") _
            & " using Excel vers. " & Application.Version _
            & ". See the <A HREF=http://www.barasch.com/excel/xlcolor.htm>Excel VBA</A> code?"
    Print #1, "<P>See also a similar chart with <A HREF=colorthing.htm>colored cells</A>."
    Print #1, "</BODY>" & vbCrLf & "</HTML>"
    Close #1
End Sub

=================

Sub ChooserTheSecond()
    Dim ChChoice, FirstHex, SecHex, ThrHex, ComplStrg, Forge, Sorge, Thorg
    ChChoice = Array("00", "33", "55", "66", "77", "99", _
        "AA", "CC", "DD", "EE", "FF")   'Array values for FORM
    Print #1, "<TD valign=top width=25%>"
    Print #1, "Choose your background color from the following 1,331 browser-friendly hues.<P>"
    Print #1, "<CENTER><FORM>"
    Print #1, "<SELECT Size=5 name=clr onChange=" & Chr(34) & _
        "document.bgColor=this.options[this.selectedIndex].value" _
        & Chr(34) & ">"     'Build JavaScript
    For Forge = LBound(ChChoice) To UBound(ChChoice) Step 1
        'Lowest index value of Array to highest
        FirstHex = ChChoice(Forge)
            For Sorge = LBound(ChChoice) To UBound(ChChoice) Step 1
                SecHex = ChChoice(Sorge)
                    For Thorg = LBound(ChChoice) To UBound(ChChoice) Step 1
                        ThrHex = ChChoice(Thorg)
                        ComplStrg = FirstHex & SecHex & ThrHex
                        If ComplStrg = "AA7733" Then
                            Print #1, "<OPTION VALUE=" & Chr(34) & ComplStrg & Chr(34) & " SELECTED>" & ComplStrg
                        Else
                            Print #1, "<OPTION VALUE=" & Chr(34) & ComplStrg & Chr(34) & ">" & ComplStrg
                        End If
              Next    'Third Tier
            Next        'Second Tier
    Next
    Print #1, "</SELECT>"
    Print #1, "</FORM></CENTER>"
    Print #1, "<P><B>Note: </B>Once you have chosen an initial color, you may scroll up and down with your keypad."
 '   Print #1, "<P>Example Budweiser Red is CC0000"
    Print #1, "</TD>"
End Sub

Since I did the original 256 color chart in 2000, new browsers can handle an almost infinite number of colors. The chart was expanded to 1,331 colors by adding several more choices to the arrays.

Updated:	06/21/2024 07:42
This page added:	07 September 2000