cellMatrix.net

In-Cell Charting

For the purposes of this post, "In-Cell" charts can be defined as very small charts, or chart pictures, that cover the height and width of one worksheet cell. Because In-Cell charts are so small, they can be very useful for dashboard reporting.

I've found that it's extremely difficult if not impossible to scale-down and manage one or more Excel charts to the size of a worksheet cell. However, it's not that difficult if the chart is converted to a picture, scaled down, and then positioned into the cell.

The simple report below provides an example of a series of charts scaled down to the size of worksheet cells. The objective of this report is to provide the current month's statistic and a high-level graphic showing the six month trend.

To create the report, I set up the data to be included in each In-Cell chart on the right side of the report outside of the page view. I then calculated a minimum and maximum for each row of data. The data set looks like this:

A single chart is created that uses one row of data as the six-month trend source. I named the chart "Cht1". A macro is used to loop through each row of data, update the chart, copy the chart as a picture, scale the picture down to the size of one worksheet cell, and then place the picture into the appropriate cell. The macro is below:

Sub BuildMicroCharts()

    Application.ScreenUpdating = False

    Dim Rng As Range
    Dim ChtRng As Range
    Dim ChtMax As Range
    Dim ChtMin As Range
    Dim Cht As ChartObject

    Set ChtRng = ActiveSheet.Range("I4:N4")
    Set ChtMax = Range("O4")
    Set ChtMin = Range("P4")
    Set Cht = ActiveSheet.ChartObjects("Cht1")

    For Each Rng In Range("F4:F11")

        ActiveSheet.ChartObjects("Cht1").Activate
        ActiveChart.SetSourceData Source:=ChtRng, PlotBy:=xlRows
        ActiveChart.Axes(xlValue).Select
        With ActiveChart.Axes(xlValue)
            .MaximumScale = ChtMax
            .MinimumScale = ChtMin
            .MajorUnit = (.MaximumScale - .MinimumScale) / 6
            .MinorUnit = (.MaximumScale - .MinimumScale) / 12
        End With

        Cht.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
        Rng.Select
        ActiveSheet.Paste
        
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Height = 15
        Selection.ShapeRange.Width = 48

        Set Rng = Rng.Offset(1, 0)
        Set ChtRng = ChtRng.Offset(1, 0)
        Set ChtMax = ChtMax.Offset(1, 0)
        Set ChtMin = ChtMin.Offset(1, 0)

    Next Rng

    Range("A1").Select

    Application.ScreenUpdating = True

End Sub

To delete the series of In-Cell charts, I refered to Ron de Bruin's site which contains many examples of code showing how to delete shapes from a worksheet. The following code deletes each In-Cell chart from the worksheet (the shape type for each In-Cell chart is 13) while preserving the actual chart that serves as the picture source (the shape type for the picture source chart is 3).

Sub DeleteShapes()
    Dim Shp As Shape
    For Each Shp In ActiveSheet.Shapes
        If Shp.Type = 13 Then Shp.Delete
    Next Shp
End Sub

Finally, Ron also provides code that shows the Type numbers of all controls on your worksheet. That code allows you to differentiate between the Type numbers for chart pictures that should be deleted and the actual chart source which you don't want to delete. That code is below:

Sub ListAllObjectsActiveSheet()
    Dim NewSheet As Worksheet
    Dim MySheet As Worksheet
    Dim myshape As Shape
    Dim I As Long

    Set MySheet = ActiveSheet
    Set NewSheet = Worksheets.Add

    With NewSheet
        .Range("A1").Value = "Name"
        .Range("B1").Value = "Visible(-1) or Not Visible(0)"
        .Range("C1").Value = "Shape type"
        I = 2

        For Each myshape In MySheet.Shapes
            .Cells(I, 1).Value = myshape.Name
            .Cells(I, 2).Value = myshape.Visible
            .Cells(I, 3).Value = myshape.Type
            I = I + 1
        Next myshape

        .Range("A1:C1").Font.Bold = True
        .Columns.AutoFit
        .Range("A1:C" & Rows.Count).Sort Key1:=Range("C1"), _
                        Order1:=xlAscending, Header:=xlYes
    End With

End Sub

Using the VBA techniques above, you can quickly scale and position many In-Cell charts in a very short period of time.