Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
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. |
#3
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]() Thank you for the help! Julian -- julianrice767 ------------------------------------------------------------------------ julianrice767's Profile: http://www.excelforum.com/member.php...o&userid=33321 View this thread: http://www.excelforum.com/showthread...hreadid=528503 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Activating a Chart object | Charts and Charting in Excel | |||
Urgent Chart Assistance | Charts and Charting in Excel | |||
Urgent Chart Questions | Excel Discussion (Misc queries) | |||
Urgent Chart Assistance Requested | Excel Discussion (Misc queries) | |||
Scrollbar on Chart Jumps to Left when Chart is Clicked | Charts and Charting in Excel |