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(quot;DynamicChartVariablequot;).Value
If IsError(dblValue) Then
Exit Sub
End If
If IsEmpty(dtStartDate) Then
Me.Range(quot;DynamicChartDataquot;).Clear
dtStartDate = DateSerial(Year(calcStart), _
Month(calcStart), Day(calcStart))
dtLastTimeStamp = _
DateAdd(quot;squot;, -(timestampIntervalSeconds 1), calcStart)
intLastIndex = 1
End If
If dblLastValue lt;gt; dblValue Then
With Me.Range(quot;DynamicChartDataquot;)
.Cells(intLastIndex, 1) = _
(calcStart - dtStartDate) * 100000
If DateDiff(quot;squot;, dtLastTimeStamp, calcStart) _
gt; timestampIntervalSeconds Then
.Cells(intLastIndex, 2) = calcStart
dtLastTimeStamp = calcStart
Else
.Cells(intLastIndex, 2) = quot;quot;
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 SubPrivate Sub createSheet()
ActiveWorkbook.Names.Add _
Name:=Me.Name amp; quot;!DynamicChartVariablequot;, _
RefersToR1C1:=quot;=quot; amp; Me.Name amp; quot;!R2C3quot;
ActiveWorkbook.Names.Add _
Name:=Me.Name amp; quot;!DynamicChartDataquot;, _
RefersToR1C1:=quot;=quot; amp; Me.Name amp; quot;!R1C11:Rquot; amp; maxIndex amp; quot;C13quot;
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 amp; quot;.runChartquot;
.Characters.Text = quot;Runquot;
End With
With Me.Buttons.Add(64.5, 96.75, 126, 45.75)
.OnAction = Me.Name amp; quot;.stopChartquot;
.Characters.Text = quot;Stopquot;
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(quot;DynamicChartVariablequot;).Formula = quot;=0 quot; amp; 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(quot;DynamicChartDataquot;).Resize(, 1)
.Values = _
Me.Range(quot;DynamicChartDataquot;).Offset(, 2).Resize(, 1)
.ChartType = xlLine
End With
With .SeriesCollection.NewSeries
.XValues = Me.Range(quot;DynamicChartDataquot;).Resize(, 1)
.Values = _
Me.Range(quot;DynamicChartDataquot;).Offset(, 1).Resize(, 1)
.ChartType = xlColumnClustered
.Border.LineStyle = xlLineStyleNone
.Interior.ColorIndex = xlColorIndexNone
.ApplyDataLabels xlShowValue
With .DataLabels
.NumberFormat = quot;hh:mm:ssquot;
.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 SubIt may be incorrect to do this 'If dblLastValue lt;gt; 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.
Thank you for the help!
Julian--
julianrice767
------------------------------------------------------------------------
julianrice767's Profile: www.excelforum.com/member.php...oamp;userid=33321
View this thread: www.excelforum.com/showthread...hreadid=528503
- Aug 14 Mon 2006 20:08
Realtime chart example
close
全站熱搜
留言列表
發表留言