Shape Charge

I was recently asked by a portfolio manager to create a new kind of chart, not available in Excel's standard set of chart styles:  a visual stock portfolio using proportionally sized boxes to represent the different stocks and bonds, coloured to show their respective investment categories, like this:

The initial prototype used a thousand tiny rows in a spreadsheet, with merged cells, background colours and cell borders to create the different boxes. This proved to be very difficult to render via code.  It also looked poor when printed, and was slow to scroll.

Looking for a better way, (because there's always a better way) I tried drawing objects.  With VBA you can easily draw a box at the position you specify, in the colour you want, and with whatever text you need inside.  It's very fast, and as I discovered, very efficient.

For a load test, I created a workbook with 100,000 rectangles in it, and the file size was only 48 kb!  And a bonus for the performance-aware: drawing boxes using VBA code is incredibly fast.

There are several ways you can set the background colour of a shape: hexadecimal, VB constants... But giving a nod to some basic design principals, I recommend using the workbook's colour pallet vial the SchemeColour property.  Excel offers a "pallet" of 80 colours which can be used in cell backgrounds, pie-chart slices, text, or shapes.  From a coding perspective, it's nice when your code refers to colour number 4, instead of &H2300FF45&

You can customize these colours, and copy pallets from one worksheet to another.  But there is one small trap to keep in mind when using SchemeColor in your VBA code: The 80 pallet slots could show up as totally different shades when your code is run on another workbook.

You see, Excel files inherit the pallet from the default template on the computer of the person that originally created it.  In my experience, many workbooks are actually copies of copies of some other model, and come with vastly different colour pallets. Colour 17 could be a nice olive drab on the test workbook I created on my laptop, but bright pink on the client's version of the report workbook.

To verify which SchemeColor values my Portfolio report should use, I created a handy macro to drop all 80 choices on a worksheet.  This test matrix is a handy reference when you need to know the colour assigned to each scheme number in the current workbook's pallet.

Below is the function I wrote to draw a sized rectangle in position on my report, as well as the macro to generate the test matrix.  I now generate this colour matrix in any model where I will need to programatically set the cell backgrounds, chart series colours and the like.  Tip: select a blank worksheet before generating the matrix.

Got the chops? Your challenge: extend the DrawBox function to handle light backgrounds where the default white text is tough to read.  Passing a text colour parameter would be one way, but figuring out how to invert it automatically would be plenty cooler.

Public Sub DrawBox(ByRef sht As Worksheet, _ 
                          ByVal lft As Single, _
                          ByVal tp As Single, _
                          ByVal wdth As Single, _
                          ByVal hite As Single, _
                          ByVal bg As Variant, _
                          ByVal strCaption As String)

'render a box using a floating box shape object
 
 Dim shap As Shape
 
'drop the rectangle on the worksheet
 Set shap = sht.Shapes.AddShape(msoShapeRectangle, lft, tp, wdth, hite)
 shap.Select
 
'set attributes
 With Selection.ShapeRange
   .Shadow.Visible = msoFalse
   .Fill.ForeColor.SchemeColor = CInt(bg)
   .Fill.Solid
   .Fill.Transparency = 0#
   .Line.Weight = 1
   .Line.DashStyle = msoLineSolid
   .Line.Style = msoLineSingle
   .Line.Transparency = 0#
   .Line.Visible = msoTrue
 End With
 
 With Selection.Characters
    .Text = strCaption
    .Font.Name = "Arial"
    .Font.FontStyle = "Regular"
    .Font.Size = 8
 End With
 
 With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
 End With

'always release object memory when done
 Set shap = Nothing
 
End Sub

Public Sub BuildColorMatrix()

 'Generate a Pallet test matrix on the active sheet
 
  Dim idx As Integer
  Dim idy As Integer
  Dim intColor As Integer
  Dim shap As Shape

 'build a 12 x 12 matrix of shapes
  For idy = 0 To 11
     For idx = 0 To 11
        intColor = intColor + 1
        If intColor > 80 Then Exit Sub
        DrawBox ActiveSheet, idx * 80, idy * 80, 75, 75, intColor, CStr(intColor)
     Next
  Next

 'always release object memory when done
  Set shap = Nothing

End Sub