1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
| Option Explicit ' Graphe dynamique animé toutes les secondes
Public Const rowDataFirst = 1, rowDataLast = 5, colData = 1 ' A1:A5 Range des valeurs en y
Public Const yValueMax = 100, nbrMaxAnim = 20
Public counterAnim As Integer ' Compteur du nombre d'animations
Dim chartObj As ChartObject, wkSheetGraph As Worksheet
Sub ChartDynamical() ' Entrée principale de la maquette
Set wkSheetGraph = ActiveSheet
counterAnim = 0
ChartData
ChartCreate wkSheetGraph
ChartAnimate
End Sub
Sub ChartCreate(wkSheet As Worksheet) ' Ajout du ChartObject sur la feuille
Const leftChart = 100, topChart = 0, widthChart = 400, heightChart = 300
Dim rngValue As Range
With wkSheet
Set rngValue = .Range(.Cells(rowDataFirst, colData), .Cells(rowDataLast, colData))
Set chartObj = .ChartObjects.Add(Left:=leftChart, Width:=widthChart, _
Top:=topChart, Height:=heightChart)
End With
With chartObj.Chart
.ChartType = xlXYScatterSmoothNoMarkers
.SetSourceData Source:=rngValue, PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=wkSheet.Name
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
.Axes(xlCategory).MaximumScale = rowDataLast
.Axes(xlCategory).MinimumScale = rowDataFirst
.Axes(xlValue).MaximumScale = yValueMax
.Axes(xlValue).MinimumScale = 0
End With
End Sub
Sub ChartData() ' Initialise la colonne A avec des valeurs y aléatoires
Dim indRow As Integer
For indRow = rowDataFirst To rowDataLast
Cells(indRow, colData) = CInt(Rnd() * yValueMax)
Next
End Sub
Sub DataUpdate() ' Change aléatoirement la valeur y en une abscisse x aléatoire
Dim indRow As Integer
indRow = CInt(Rnd() * (rowDataLast - rowDataFirst)) + rowDataFirst
wkSheetGraph.Cells(indRow, colData) = CInt(Rnd() * yValueMax)
counterAnim = counterAnim + 1
Application.StatusBar = counterAnim
If counterAnim < nbrMaxAnim Then
ChartAnimate ' Relance l'animation dans une seconde
ElseIf Not chartObj Is Nothing Then
chartObj.Delete
Set chartObj = Nothing
End If
End Sub
Sub ChartAnimate() ' Lance l'animation au bout d'un délai d'une seconde
Const strTimerSub = "DataUpdate", delay = 1 ' every seconde
Dim timeChartAnimate As Double
timeChartAnimate = Now + TimeSerial(0, 0, delay)
Application.OnTime timeChartAnimate, strTimerSub, , True
End Sub |
