[XL-2013] Graphe en nuage de poids avec valeur max, min et objectif en format courbe

1 pièce(s) jointe(s)

Graphe en nuage de poids avec valeur max, min et objectif en format courbe

:help:

Bonjour,

J’ai un problème mais sincèrement je ne dispose d’une idée comment le résoudre. Veuillez m’aider s’il vous plait !:aie::aie:

J’ai une ensemble d'individus qui suivent un programme d'entrainement pour chaque membre on note les jours d'entrainement « JE », les coefficients de perte de poids « Coef min » et « Coef objectif » et « Coefi max » (soi-disant les normes) et la « ValeuR » c’est le coefficient réalisé effectivement par l’individu (les données se trouvent dans la feuille 2.

je souhaite créer une macro qui me permet d'effectuer un graphe en nuage de points dans la feuille 1 avec "JE" en axe des X et les "Coef mi ,Coef objectif, coef max" et "valeur R" en axe y, par ailleurs je souhaite que "Coef min" "Coef objectif" et "Coef max" soit en forme de courbe (délimitant une zone minimale et une zone maximale et un objectif) et la « ValeuR » garde la forme d'un nuage de poids, pour que chaque valeur réalisée par un individu soit représentée par un point avec une étiquette portant le nom de l’individu ; et puisque le tableau n'est pas exhaustif donc la macro doit prendre en considération à chaque fois toutes les valeurs jusqu’à la dernière ligne vide du tableau ( j'ai attaché un exemple de graphe en format image dans mon fichier Excel).

Pièce jointe 171570

Je vous remercie d'avance!

Bonjour !

Pour avoir une bonne base, tu peux utiliser l'enregistreur de macro ! Ensuite, il te faut adapter un peu le code, définir les paramètres variables, c'est là que tu aura plus de réponse !

Bonjour Nico Chg ,Bonjour Forum,

Effectivement c'est ce que je viens de faire (un enregistrement d'un Marco) mais j'ai confronté un problème au niveau de ma feuille il y a 4 graphes donc lorsque j’applique la macro il s'applique à tous mes graphes et ce qu'il y a des modifications à réaliser à telle sorte que mon code s'applique juste au graphe concerné.

Mon code.

Code:

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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Option Explicit
 
Sub graphe2()
'
    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Name = "=Feuil1!$E$69"
    ActiveChart.FullSeriesCollection(1).XValues = "=Feuil1!$D$70:$D$74"
    ActiveChart.FullSeriesCollection(1).Values = "=Feuil1!$E$70:$E$74"
 
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(2).Name = "=Feuil1!$F$69"
    ActiveChart.FullSeriesCollection(2).XValues = "=Feuil1!$D$70:$D$74"
    ActiveChart.FullSeriesCollection(2).Values = "=Feuil1!$F$70:$F$74"
 
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(3).Name = "=Feuil1!$G$69"
    ActiveChart.FullSeriesCollection(3).XValues = "=Feuil1!$D$70:$D$74"
    ActiveChart.FullSeriesCollection(3).Values = "=Feuil1!$G$70:$G$74"
 
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(4).Name = "=Feuil1!$B$78:$B$8100"
    ActiveChart.FullSeriesCollection(4).XValues = "=Feuil1!$C$78:$C$8100"
    ActiveChart.FullSeriesCollection(4).Values = "=Feuil1!$D$78:$D$8100"
 
    'Mise en forme des série
 
    ActiveChart.Axes(xlValue).MaximumScale = 5
    ActiveChart.Axes(xlValue).MinimumScale = 0.5
    ActiveChart.Axes(xlCategory).MaximumScale = 12
    ActiveChart.FullSeriesCollection(1).Smooth = True
    ActiveChart.FullSeriesCollection(2).Smooth = True
    ActiveChart.FullSeriesCollection(3).Smooth = True
    ActiveChart.ChartTitle.Select
    Selection.Delete
 
     ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
    End With
 
    ActiveChart.FullSeriesCollection(2).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
    End With
 
   ActiveChart.FullSeriesCollection(3).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
    End With
 
    Selection.MarkerStyle = -4142
    ActiveChart.FullSeriesCollection(2).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
    End With
   Selection.MarkerStyle = -4142
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
 
 
    Selection.MarkerStyle = -4142
    ActiveChart.FullSeriesCollection(3).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
 
    'Label
 
      ActiveChart.FullSeriesCollection(4).ApplyDataLabels
    ActiveChart.FullSeriesCollection(4).DataLabels.Select
    ActiveChart.SeriesCollection(4).DataLabels.Format.TextFrame2.TextRange. _
        InsertChartField msoChartFieldRange, "=Feuil1!$B$78:$B$8200", 0
    Selection.ShowRange = True
    Selection.ShowValue = False
 
 
  'Position du graphe (ici j'ai un problème)
 
 ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.Shapes("Graphique 1").ScaleWidth 0.7906735493, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Graphique 1").ScaleHeight 0.8504620756, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.Shapes("Graphique 1").IncrementLeft 85.8333858268
    ActiveSheet.Shapes("Graphique 1").IncrementTop -33.3333858268
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.Shapes("Graphique 1").ScaleWidth 0.9678032168, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Graphique 1").ScaleHeight 0.895904358, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.0151218259, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.0252590488, msoFalse, _
        msoScaleFromTopLeft
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 245
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.Shapes("Graphique 1").Line.Visible = msoFalse
    Range("L10").Select
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveSheet.Shapes("Graphique 1").IncrementTop 2.5
 
End Sub

Merci beaucoup!

Bonjour,

Effectivement, ta macro permet de créer 4 graphes, et donc de tous les modifier. Comment définis tu le "graphe concerné" ? Est ce une valeur dans une cellule ? Un listbox ? Une lecture dans la pensée de l'utilisateur ?

1 pièce(s) jointe(s)

Bonjour,
Regarde la pièce jointe!

Je vous remercie infiniment ça marche super bien merci :plusser:;)