Excel OLE - Display the Color Chart

Keywords:   Excel OLE - Display the Color Chart

; Winbatch Excel OLE - Display the Color Chart
; use the colorindex= in your code to color code
; worksheet cells
; Stan Littlefield - November 23, 2002

; ======== November 24, Script Enhancements
; 1. Script Now uses an XML lookup to find
;    the actual color name
; 2. The Excel Interior.Color property is converted to
;    HEX with the Dec2Hex add-on function in Analysis Toolpak
; 3. Some values may not be found and default to ColorIndex=
;    otherwise, you can paste Column C into your
;    Excel scripts and have color lookup constants
; ======== Stan Littlefield


;UDF to check for existence of Excel Addon
#DefineFunction isToolPak( DB, cAddon )
iT   = @FALSE
AI               = DB.AddIns
n                = AI.Count
For i= 1 To n
   x = DB.AddIns(i)
   If x.Title == cAddon && ! (x.Installed)
      x.Installed = @TRUE
      iT=@TRUE
   Else
      x.Installed = @FALSE
   Endif
Next
ObjectClose( AI )
Return( iT )
#EndFunction


cXML             = StrCat(DirGet(), "COLORS.XML")
If ! FileExist( cXML ) Then Exit
cAddon           = "Analysis ToolPak"
DB               = ObjectOpen("Excel.Application")
DB.Visible       = @TRUE
DB.UserControl   = @TRUE
DB.DisplayAlerts = @FALSE
oAPP             = DB.Workbooks
oXLS             = oAPP.add
oWS              = oXLS.Worksheets("Sheet1")
oWS.Activate()

If ! isToolPak( DB,cAddon )
   If isToolPak( DB,cAddon ) Then Goto getcolors
Else
   Goto getcolors
Endif

:end
ObjectClose( oWS )
ObjectClose( oXLS )
ObjectClose( oAPP )
ObjectClose(DB)
Message("Script is Complete","Save it or Quit")
Exit

:getcolors
; open up the 'lookup' XML File as a Recorset
adOpenDynamic    = 2
adLockReadOnly   = 1
adLockOptimistic = 3
adCmdTableDirect = 256
RS               = ObjectOpen("ADODB.RecordSet")
RS.Open(cXML,"Provider=MSPersist;",adOpenDynamic,adLockReadOnly,adCmdTableDirect)
oC               = RS.Fields(0)

; create index on HEXCODE field
fld              = RS.fields(1)
opt              = fld.Properties("OPTIMIZE")
opt.Value        = @TRUE

; go back to formating the Excel sheet
oCell            = oWS.Columns("A")
oCell.ColumnWidth = 25
oCell            = oWS.Columns("C")
oCell.ColumnWidth = 25

For i = 0 To 56
   ; set background color for each row in Column A
   oCell         = oWS.Cells(i + 1, 1)
   oInt          = oCell.Interior
   oInt.ColorIndex = i
   nColor        = oInt.Color  ; needed for Hex Conversion

   ; place HEX string for color in Column B
   oCell         = oWS.Cells(i + 1, 2)
   ; the Dec2Hex Function is part of the Analysis Toolpak
   ; there may be an easier, pure Winbatch method
   ; to make the conversion
   oCell.Formula = "=Dec2Hex( %nColor%,6 )"
   ; Excel places nibbles in reverse order, so reorder the
   ; Hex Codes
   cColor        = oCell.Value
   cColor        = StrCat( StrSub(cColor,5,2),StrSub(cColor,3,2),StrSub(cColor,1,2) )
   If StrIndex( "0123456789",StrSub(cColor,1,1),1,@FWDSCAN )
      cColor     = StrCat( "'",cColor)
   Endif
   oCell.Value   = cColor
   cColor        = StrReplace( cColor,"'","") ; so lookup succeeds

   ; finally, set up color constant in Column C
   cVar          = "ColorIndex"
   RS.Find("HEXCODE = '%cColor%'")
   If ! (RS.eof) Then cVar = oC.Value
   RS.MoveFirst()
   oCell         = oWS.Cells(i + 1, 3)
   oCell.Value   = StrCat( cVar," = ",i )

Next
RS.Close()
ObjectClose( RS )
ObjectClose( oCell )
Goto end

The XML File:

COLORS.XML

Article ID:   W15628

File Created: 2017:08:29:11:58:44

Last Updated: 2017:08:29:11:58:44

Database Search

TechHome

Excel OLE - Display the Color Chart

The XML File: