Discussion :

[chandav28]

Bonjour à tous,

Je me bats avec un code depuis trop longtemps alors je sollicite votre aide.
Je souhaite attaché des label aux points de mon graphique.
Le code est long et peu optimisé mais c'est surtout à cause des variable que j'ai définie et je ne pense pas que ce soit là ou ça bloque.

Je pense que mon type de graphique n'est pas adapté pour mettre des labels avec le code attach label que j'utilise mais je ne sais pas comment faire autrement. En effet à la base j'utilisais un autre code pour le graphique et ça marchait parfaitement..

Pouvez vous m'aider merci d'avance,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub CreateGraphfood()
 Dim minimumX As Double
 Dim MaximumX As Double
  Dim minimumY As Double
 Dim MaximumY As Double
 Dim CrossesatX As Double
 Dim CrossesatY As Double
 Dim DifferenceaveragemaxX As Double
 Dim DifferenceaveragemaxY As Double
 Dim DifferenceaverageminX As Double
 Dim DifferenceaverageminY As Double
  Dim retreatedminimumX As Double
 Dim retreatedMaximumX As Double
  Dim retreatedminimumY As Double
 Dim retreatedMaximumY As Double
 Dim EcartX As Double
 Dim EcartY As Double
 Dim LastRowf As Integer

LastRowf = Sheets("Food_Menu_Engeneering").Range("B" & 10).End(xlDown).Row

minimumX = Application.WorksheetFunction.Min(Sheets("Food_Menu_Engeneering").Range("D10:D" & LastRowf))
MaximumX = Application.WorksheetFunction.Max(Sheets("Food_Menu_Engeneering").Range("D10:D" & LastRowf))
minimumY = Application.WorksheetFunction.Min(Sheets("Food_Menu_Engeneering").Range("N10:N" & LastRowf))
MaximumY = Application.WorksheetFunction.Max(Sheets("Food_Menu_Engeneering").Range("N10:N" & LastRowf))
CrossesatX = Sheets("Food_Menu_Engeneering").Range("H26").Value
CrossesatY = Sheets("Food_Menu_Engeneering").Range("J23").Value
DifferenceaveragemaxX = MaximumX - CrossesatX
DifferenceaveragemaxY = MaximumY - CrossesatY
DifferenceaverageminX = CrossesatX - minimumX
DifferenceaverageminY = CrossesatY - minimumY
EcartX = Abs(DifferenceaveragemaxX - DifferenceaverageminX)
EcartY = Abs(DifferenceaveragemaxY - DifferenceaverageminY)
 
'Calculation of the Variable Maximum of the X axis
If DifferenceaverageminX > DifferenceaveragemaxX Then
retreatedMaximumX = MaximumX + EcartX
Else: retreatedMaximumX = MaximumX
End If

'Calculation of the Variable Minimum of the X axis

If DifferenceaveragemaxX > DifferenceaverageminX Then
retreatedminimumX = minimumX - EcartX
Else: retreatedminimumX = minimumX
End If

'Calculation of the Variable Maximum of the Y axis
If DifferenceaverageminY > DifferenceaveragemaxY Then
retreatedMaximumY = MaximumY + EcartY
Else: retreatedMaximumY = MaximumY
End If

'Calculation of the Variable Minimum of the Y axis

If DifferenceaveragemaxY > DifferenceaverageminY Then
retreatedminimumY = minimumY - EcartY
Else: retreatedminimumY = minimumY
End If

Dim X_Value_Array As String
    Dim Y_Value_Array As String
    Dim i As Integer
    
    X_Value_Array = "Food_Menu_Engeneering!$D$10:$D$" & LastRowf
 Y_Value_Array = "Food_Menu_Engeneering!$N$10:$N$" & LastRowf
     
     
    With ActiveSheet.ChartObjects.Add(Left:=350, Width:=500, Top:=450, Height:=300)
        With .Chart
            .ChartType = xlXYScatter
            .Axes(xlValue).HasMajorGridlines = False
            'Popularity X
            .Axes(xlCategory).CrossesAt = CrossesatX
.Axes(xlCategory).MinimumScale = retreatedminimumX
.Axes(xlCategory).MaximumScale = retreatedMaximumX
            'Profitability Y
            .Axes(xlValue).CrossesAt = CrossesatY
.Axes(xlValue).MinimumScale = retreatedminimumY
.Axes(xlValue).MaximumScale = retreatedMaximumY
            .HasLegend = False
            .HasTitle = False
            With .SeriesCollection.NewSeries
                .Name = "Food Menu Engeneering"
                .XValues = X_Value_Array
                .Values = Y_Value_Array

            End With
           .Location Where:=xlLocationAsObject, Name:="Food_Menu_Engeneering"
       
        End With
        
    End With
 
 
AttachLabelsToPoints
End Sub

Le code attach label et le suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub AttachLabelsToPoints()
 
 
   'Dimension variables.
   Dim Counter As Integer, ChartName As String, xVals As String
 
   ' Disable screen updating while the subroutine is run.
   Application.ScreenUpdating = False
 
   'Store the formula for the first series in "xVals".
   xVals = ActiveChart.SeriesCollection(1).Formula
 
   'Extract the range for the data from xVals.
   xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
      Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
   xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
   Do While Left(xVals, 1) = ","
      xVals = Mid(xVals, 2)
   Loop
 
   'Attach a label to each data point in the chart.
    For Counter = 1 To Range(xVals).Cells.Count
        ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = True
        ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = Range(xVals).Cells(Counter, 1).Offset(0, -2).Value
   Next Counter
 
End Sub