VBA add a thermometer chart


0. Quick guide - use VBA to add a thermometer chart to WS


In this module:

  1. VBA code - to add a thermometer chart to a worksheet (WS) as a clustered column chart

1. Battery chart


The demonstration worksheet is shown in figure 1.


thermo chart
Fig 1: - a WS thermometer chart with a demonstration ActiveX ScrollBar control

2. VBA code to add thermometer chart


Code 1 uses the ChartObjects.Add method with parameters passed by name (code 1 line 5).



Code 1: Sub xlfAddThermoChart procedure adds a chart element to the WS (see figure 1) 
Sub xlfAddThermoChart()
Dim oCht As ChartObject
Dim L As Integer, T As Integer, H As Integer, W As Integer  ' Series Points column dimensions
Dim TLC As String, TLCtop As Integer, TLCleft As Integer    ' WS TopLeftCell
TLC = "B9"

TLCtop = Range(TLC).Top
TLCleft = Range(TLC).Left

Set oCht = ActiveSheet.ChartObjects.Add(Top:=TLCtop, Left:=TLCleft, Width:=250, Height:=250)

With oCht.Chart
    .SetSourceData Range("Thermo")
    .ChartType = xlColumnClustered
    .PlotBy = xlRows

    .Axes(xlValue).MaximumScale = 1
    .Axes(xlValue).MinimumScale = 0

    .SeriesCollection(2).AxisGroup = xlSecondary
    .SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(0, 0, 255)
    .SeriesCollection(2).Format.Fill.Visible = msoFalse

    .Axes(xlValue, xlSecondary).Delete
    .Axes(xlValue).MajorGridlines.Delete
    .Axes(xlCategory).Delete
    .Axes(xlValue).MajorTickMark = xlInside

    With .SeriesCollection(1)
        .HasDataLabels = True
        .DataLabels.Type = xlValue
        .DataLabels.Orientation = xlUpward
        .DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
    End With

    .Legend.Delete
    .PlotArea.Height = .ChartArea.Height * 0.8
    .ChartArea.Width = 125

    With .SeriesCollection(2).Points(1)
        L = .Left
        T = .Top
        H = .Height
        W = .Width
    End With

    .Shapes.AddShape msoShapeOval, Left:=(L + W / 2 - 25), Top:=(T + H - 50 * 0.1), Width:=50, Height:=50
    .Shapes("Oval 1").Line.Visible = msoFalse
End With
    'oCht.Delete
End Sub

Code 2 provides the code for the Worksheet and ScrollBar Change events. Worksheet_change is restricted to the ScrollBar link cell by the Target parameter (line 15).



Code 2: Sub xlfAddThermoChart procedure adds a chart element to the WS (see figure 1) 
' Module [Sheet1(Code) "Thermo Chart"]

Private Sub cmdAddChart_Click()
    If Application.Run("Module4.xlfChartsCount") = 0 Then Call xlfAddThermoChart
End Sub

Private Sub cmdChartDelete_Click()
    Application.Run ("Module4.xlfChartsDeleteAll")
End Sub

Private Sub scrAchieved_Change()
    Range("thermo")(1, 2).Value = scrAchieved.Value / 1000
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = Range("thermo")(1, 2).Address Then
        scrAchieved.Value = Range("thermo")(1, 2).Value * 1000
    End If
End Sub




References