I discovered a while ago that you can create a Shape from a user-defined function.
This opens the possibility for having custom made graphics dependent on other cells. Meaning, when the data changes, your graphic changes too.
Some possible graphics include line charts, gantt charts, Excel12 style traffic lights.
As an example, I’ve put together a very basic Sparkline (in-cell line chart) graphic. If you want to know more about Sparklines, start at ewbi.develops
I have a userdefined function named LineChart. It will take a row of values and use them to create a simple linechart within the cell containing the formula.
The formula in cell K1 is =LineChart(A1:J1, 203)
A1:J1 are the data values
203 repesents the colour value for RGB(203, 0, 0)
Finally, the code behind the user-defined function:
Function LineChart(Points As Range, Color As Long) As String
Const cMargin = 2
Dim rng As Range, arr() As Variant, i As Long, j As Long, k As Long
Dim dblMin As Double, dblMax As Double, shp As Shape
Set rng = Application.Caller
ShapeDelete rng
For i = 1 To Points.Count
If j = 0 Then
j = i
ElseIf Points(, j) > Points(, i) Then
j = i
End If
If k = 0 Then
k = i
ElseIf Points(, k) < Points(, i) Then
k = i
End If
Next
dblMin = Points(, j)
dblMax = Points(, k)
With rng.Worksheet.Shapes
For i = 0 To Points.Count - 2
Set shp = .AddLine( _
cMargin + rng.Left + (i * (rng.Width - (cMargin * 2)) / (Points.Count - 1)), _
cMargin + rng.Top + (dblMax - Points(, i + 1)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin), _
cMargin + rng.Left + ((i + 1) * (rng.Width - (cMargin * 2)) / (Points.Count - 1)), _
cMargin + rng.Top + (dblMax - Points(, i + 2)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin))
On Error Resume Next
j = 0: j = UBound(arr) + 1
On Error GoTo 0
ReDim Preserve arr(j)
arr(j) = shp.Name
Next
With rng.Worksheet.Shapes.Range(arr)
.Group
If Color > 0 Then .Line.ForeColor.RGB = Color Else .Line.ForeColor.SchemeColor = -Color
End With
End With
LineChart = ""
End Function
Sub ShapeDelete(rngSelect As Range)
Dim rng As Range, shp As Shape, blnDelete As Boolean
For Each shp In rngSelect.Worksheet.Shapes
blnDelete = False
Set rng = Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), rngSelect)
If Not rng Is Nothing Then
If rng.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then blnDelete = True
End If
If blnDelete Then shp.Delete
Next
End Sub
ShapeDelete is an alteration of the ShapeDelete code available on my website
Note that Application.Caller is used to determine which cell is running the formula. That is also used for determining the boundaries of the cell.
One “gotcha” about UDF charts is that you cannot create any shape that writes Text. That can make drawing Legend tables or Value indicators difficult. That said, it’s great for drawing graphics.
