Excel VBA

css navigation by Css3Menu.com

Produce 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 hours!). A fter 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.


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

Sub MakeHTMcolors()
    'Defining each digit of the six in 3 pairs for HTML colors Ex. #99FFCC
    ColChoice = Array("00", "33", "66", "99", "CC", "FF")
    DecChoice = Array("000", "051", "102", "153", "204", "255")
    QuoTe = Chr(34)
    POS = 0
    Open "c:\alan\excel\ColorThing.htm" For Output As #1
    Print #1, "<HTML>"
    Print #1, "<HEAD>"
    Print #1, "<TITLE>HTML Color Chart</TITLE>"
    Print #1, "</HEAD>"
    Print #1, "<BODY>"
    Print #1, "<h1>Color Chart</h1>"
    Print #1, "<TABLE border=" & Chr(34) & "0" & Chr(34) & ">"
    For ForeColor = 0 To 5 Step 1   'First value in array is zero
    Print #1, "</TR>"
        FirsTier = ColChoice(ForeColor)
        firstDec = DecChoice(ForeColor)
            For s2NDpACK = 0 To 5 Step 1
                SecTier = ColChoice(s2NDpACK)
                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 = 0 To 5 Step 1
                        ThrdTier = ColChoice(t3RDpACK)
                        thirdDec = DecChoice(t3RDpACK)
                        CompleteY = FirsTier & SecTier & ThrdTier
                Select Case SecTier
                    Case "00", "33"
                        Print #1, "<TR><TD bgcolor=" & Chr(34) & FirsTier & SecTier _
                            & ThrdTier & Chr(34) & " align=center width=95><B><FONT COLOR=" _
				& Chr(34) _
                            & "#FFFFFF" & Chr(34) & ">" & FirsTier & SecTier & ThrdTier _
                            & "<BR>" & firstDec & "," & secDec & "," & thirdDec & _
				"</FONT></B></TD></TR>"
                    Case Else
                        Print #1, "<TR><TD bgcolor=" & Chr(34) & FirsTier & SecTier _
                            & ThrdTier & Chr(34) & " align=center width=95><B>" & FirsTier _
                            & SecTier & ThrdTier & "<BR>" & firstDec & "," & secDec & "," _
                            & thirdDec & "</B></TD></TR>"
                End Select
        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=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
    MsgBox "Done with Fonts & Cells", 64, "Make list..."
End Sub

Sub ChooserTheSecond()
    Dim ChChoice, FirstHex, SecHex, ThrHex, ComplStrg, Forge, Sorge, Thorg
    ChChoice = Array("00", "33", "66", "99", "CC", "FF")
    Print #1, "<TD valign=top width=25%>"
    Print #1, "Choose your background color from the following 216 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) & ">"
    For Forge = 0 To 5 Step 1   'First value in array is zero
        FirstHex = ChChoice(Forge)
            For Sorge = 0 To 5 Step 1
                SecHex = ChChoice(Sorge)
                    For Thorg = 0 To 5 Step 1
                        ThrHex = ChChoice(Thorg)
                        ComplStrg = FirstHex & SecHex & ThrHex
                        If ComplStrg = "FFCCCC" 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


© 2000-2024

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