Realtime chart example

[ntoze]

Hi,

The following code builds a chart displaying realtime data.

To use, copy all the code into a worksheet object in the VBA editor in
a new workbook with calculation set to automatic. Then run the
'createSheet' macro from the VBA editor. You should then get a chart
and two buttons on the sheet.

The important functions are Worksheet_Calculate and createChart.
The runChart and stopChart functions are just for demonstration
purposes. In a real application you might put a realtime function in
the range 'DynamicChartVariable', e.g. =blp|M!'USDEUR Curncy,[ASK]'


-----------------------------------------------------------------
Option Explicit

' Maximum number of data points to display
Private Const maxIndex As Integer = 500

' This controls number of timestamp labels shown
' (which prevents them overlapping).
' Set it to:
' (time in seconds taken to generate 'maxIndex' data points)
' divided by (number of timestamp labels required)
Private Const timestampIntervalSeconds As Integer = 200

Private dtStartDate As Variant
Private dtLastTimeStamp As Date
Private dblLastValue As Variant
Private intLastIndex As Integer

' This is just for our dummy realtime data mechanism
Private bRunning As Boolean

Private Sub Worksheet_Calculate()
Dim calcStart As Date, dblValue As Variant

calcStart = Now
dblValue = Me.Range("DynamicChartVariable").Value
If IsError(dblValue) Then
Exit Sub
End If

If IsEmpty(dtStartDate) Then
Me.Range("DynamicChartData").Clear
dtStartDate = DateSerial(Year(calcStart), _
Month(calcStart), Day(calcStart))
dtLastTimeStamp = _
DateAdd("s", -(timestampIntervalSeconds + 1), calcStart)
intLastIndex = 1
End If

If dblLastValue <> dblValue Then
With Me.Range("DynamicChartData")
.Cells(intLastIndex, 1) = _
(calcStart - dtStartDate) * 100000
If DateDiff("s", dtLastTimeStamp, calcStart) _

timestampIntervalSeconds Then

.Cells(intLastIndex, 2) = calcStart
dtLastTimeStamp = calcStart
Else
.Cells(intLastIndex, 2) = ""
End If
.Cells(intLastIndex, 3) = dblValue
End With

dblLastValue = dblValue

If intLastIndex = maxIndex Then
intLastIndex = 1
Else
intLastIndex = intLastIndex + 1
End If
End If
End Sub


Private Sub createSheet()
ActiveWorkbook.Names.Add _
Name:=Me.Name & "!DynamicChartVariable", _
RefersToR1C1:="=" & Me.Name & "!R2C3"
ActiveWorkbook.Names.Add _
Name:=Me.Name & "!DynamicChartData", _
RefersToR1C1:="=" & Me.Name & "!R1C11:R" & maxIndex & "C13"

Me.Cells(1, 11) = (Now - Application.Floor(Now, 1)) * 100000
Me.Cells(1, 12) = Now
Me.Cells(1, 13) = 0.6

With Me.Buttons.Add(66.75, 40.5, 123, 39.75)
.OnAction = Me.Name & ".runChart"
.Characters.Text = "Run"
End With
With Me.Buttons.Add(64.5, 96.75, 126, 45.75)
.OnAction = Me.Name & ".stopChart"
.Characters.Text = "Stop"
End With

createChart
End Sub

Public Sub runChart()
Dim newHour As Integer, newMinute As Integer, _
newSecond As Integer, upperbound As Integer, _
lowerbound As Integer, waitTime As Date
upperbound = 8
lowerbound = 1
bRunning = True
Do While bRunning
Me.Range("DynamicChartVariable").Formula = "=0+" & Rnd

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + _
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

DoEvents
Loop
End Sub

Public Sub stopChart()
bRunning = False
End Sub

Private Sub createChart()
With Me.ChartObjects.Add(50, 150, 500, 300)
.Placement = xlFreeFloating
With .Chart
With .SeriesCollection.NewSeries
.XValues = Me.Range("DynamicChartData").Resize(, 1)
.Values = _
Me.Range("DynamicChartData").Offset(, 2).Resize(, 1)
.ChartType = xlLine
End With

With .SeriesCollection.NewSeries
.XValues = Me.Range("DynamicChartData").Resize(, 1)
.Values = _
Me.Range("DynamicChartData").Offset(, 1).Resize(, 1)
.ChartType = xlColumnClustered
.Border.LineStyle = xlLineStyleNone
.Interior.ColorIndex = xlColorIndexNone
.ApplyDataLabels xlShowValue
With .DataLabels
.NumberFormat = "hh:mm:ss"
.Position = xlLabelPositionInsideBase
.Orientation = xlUpward
.Font.Bold = True
End With
.AxisGroup = xlSecondary
End With

With .Axes(xlCategory)
.Crosses = xlAutomatic
.CategoryType = xlTimeScale
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
.AxisBetweenCategories = False
End With
With .Axes(xlValue, xlSecondary)
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
End With

.PlotArea.Interior.ColorIndex = xlNone
.HasLegend = False
End With
End With
End Sub

 

[ntoze]

It may be incorrect to do this 'If dblLastValue <> dblValue Then' in
the sheet_calculate function. Probably, that check should be deleted.
It was there to try to prevent points being added when the sheet
recalculated due to cells other than the one being charted.

 

[julianrice767]

Thank you for the help!

Julian