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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
| Const N As Integer = 2500 'nombre de points à tracer
'Procédure d'effacement de la feuille et création d'un graphique vide mis en forme
Private Sub Preparer(ByVal Sh As Worksheet)
Dim Ch As ChartObject
Application.ScreenUpdating = False
With Sh
For Each Ch In .ChartObjects
Ch.Delete
Next Ch
.UsedRange.Delete
Set Ch = .ChartObjects.Add(350, 30, 250, 250)
With Ch.Chart
.ChartType = xlXYScatter
.Axes(xlValue).MaximumScale = 1.1
.Axes(xlValue).MinimumScale = 0
.Axes(xlCategory).MaximumScale = 1.1
.Axes(xlCategory).MinimumScale = 0
.HasLegend = False
.HasTitle = False
End With
Set Ch = Nothing
End With
End Sub
'Procédure de traçage d'unz serie colorée avec Klr et pour X: Rg et Y: colonne de gauche
Private Sub Tracer(ByVal Ch As Chart, ByVal Rg As Range, ByVal Klr As Long)
Application.ScreenUpdating = False
With Ch.SeriesCollection.NewSeries
.XValues = Rg
.Values = Rg.Offset(0, 1)
.MarkerStyle = 8
.MarkerSize = 6
With .Format
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = Klr
End With
End With
End Sub
'Remplissage des colonnes A et B de X et Y (cercle) et le colonnes C et D (carrée)
Private Sub Remplir(ByVal Sh As Worksheet)
Dim X As Double, Y As Double, R As Double
Dim TbC() As Double, TbD() As Double
Dim i As Integer, j As Integer, k As Integer
Application.ScreenUpdating = False
Randomize
For i = 1 To N
X = i / N
Y = Rnd
R = X ^ 2 + Y ^ 2
If R <= 1 Then
j = j + 1
ReDim Preserve TbD(1 To 2, 1 To j)
TbD(1, j) = X
TbD(2, j) = Y
Else
k = k + 1
ReDim Preserve TbC(1 To 2, 1 To k)
TbC(1, k) = X
TbC(2, k) = Y
End If
Next i
With Sh
.Range("A1").Resize(j, 2) = Application.Transpose(TbD)
.Range("C1").Resize(k, 2) = Application.Transpose(TbC)
End With
End Sub
'Procédure de lancement
Sub Appliquer()
Dim S(1 To 2) As Double
Dim LastLig As Long
Dim Ws As Worksheet
Dim Ch As Chart
Dim i As Byte
Dim P As Double
Application.ScreenUpdating = False
Set Ws = Worksheets("Feuil1")
Preparer Ws
Remplir Ws
With Ws
Set Ch = .ChartObjects(1).Chart
For i = 1 To 2
LastLig = .Cells(.Rows.Count, 2 * i - 1).End(xlUp).Row
S(i) = LastLig
Tracer Ch, .Range(.Cells(1, 2 * i - 1), .Cells(LastLig, 2 * i - 1)), RGB(255 * (i - 1), 255 * (2 - i), 0)
Next i
P = 4 * S(1) / (S(1) + S(2))
With .Range("H1")
.Value = "Pi (pour N=" & N & "): " & P
With .Font
.Size = 14
.Bold = True
End With
End With
Set Ch = Nothing
End With
Set Ws = Nothing
End Sub |
