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
| Option Explicit
Sub Graphique()
Dim wA As Worksheet, wP As Worksheet
Dim i As Long, j As Long, k As Long
Dim sRef As String, rChart As Range, s As Object
Set wA = ThisWorkbook.Worksheets("Analysis")
Set wP = ThisWorkbook.Worksheets("Pivot2")
wP.Range("C1:R33").ClearContents
sRef = Range("A" & ActiveCell.Row).Value '--- Ref (en colonne A)
i = 6 '--- 6 = n° ligne premières données
While wA.Cells(i, 1) <> sRef
i = i + 1 '--- i = n° première ligne du groupe de données
Wend
j = 8 '--- 8 = n° première colonne de données
While wA.Cells(5, j) <> "-" _
And wA.Range("A5").Offset(0, j) <> "Average"
j = j + 1
Wend
j = j - 1 '--- j = n° dernière colonne du groupe de données
k = i
While wA.Cells(k, 1) = sRef
k = k + 1
Wend
k = k - 1 '--- k = n° dernière ligne du groupe
'--- recopie valeurs groupe données de feuille Analysis dans feuille Pivot2
'wA.Range(Cells(i, 8), Cells(k, j)).Select
wA.Range(Cells(i, 8), Cells(k, j)).Copy
wP.Range("C4").PasteSpecial xlPasteValues
'--- recopie valeurs ligne X
wA.Range(Cells(5, 8), Cells(5, j)).Copy
wP.Range("C1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
'--- inscrit valeurs pour ligne max et ligne min
sRef = Range(Cells(2, 3), Cells(2, j - 5)).Address
wP.Range(sRef) = wA.Cells(i, 3).Value + wA.Cells(i, 4).Value
sRef = Range(Cells(3, 3), Cells(3, j - 5)).Address
wP.Range(sRef) = wA.Cells(i, 3).Value + wA.Cells(i, 5).Value
'--- mise à jour du graphique
wP.Select
wP.ChartObjects("Graphique 3").Activate
With ActiveChart
'--- supprime anciennes séries de données (sauf Mim et Max)
For Each s In .SeriesCollection
If s.Name <> "Max" And s.Name <> "Min" Then
s.Delete
End If
Next
'--- actualise, ajoute séries
Set rChart = wP.Range(Cells(1, 3), Cells(1, j - 5))
.FullSeriesCollection(1).XValues = rChart '--- X
.FullSeriesCollection(1).Values = rChart.Offset(1, 0) '--- Max
.FullSeriesCollection(2).Values = rChart.Offset(2, 0) '--- Min
For j = 0 To k - i
.SeriesCollection.NewSeries
.FullSeriesCollection(3 + j).Name = wP.Range("B" & 4 + j)
.FullSeriesCollection(3 + j).Values = rChart.Offset(3 + j, 0)
.FullSeriesCollection(3 + j).AxisGroup = 2
.FullSeriesCollection(3 + j).ChartType = xlXYScatter
Next
'--- configure échelles
.Axes(xlValue, xlPrimary).MaximumScale = wP.Range("A2")
.Axes(xlValue, xlSecondary).MaximumScale = wP.Range("A2")
.Axes(xlValue, xlPrimary).MinimumScale = wP.Range("A4")
.Axes(xlValue, xlSecondary).MinimumScale = wP.Range("A4")
.Axes(xlValue, xlSecondary).TickLabels.NumberFormat = "#.##0,000"
.Refresh
End With
Set rChart = Nothing
Set wA = Nothing
Set wP = Nothing
End Sub |
