Tracé de rectangles sur un graphique

Version imprimable

16/04/2010, 15h23
boby1

Tracé de rectangles sur un graphique
Bonjour,

Je souhaiterais réaliser une macro sur Excel qui, sur un graphe type nuage de points, puisse me tracer un rectangle qui encadre ma série de données.

J'explique un peu plus :
-j'ai plusieurs séries de données représentées chacunes par plusieurs points
-les points représentent des dimensions type diamètre (en X) et épaisseur (en Y)
-par exemple, je voudrais alors que en sélectionnant une des séries, ou bien même pour toutes en automatique, qu'Excel trace un rectangle dont le bord gauche passe par le point au Xmini, le bord droit par le point X maxi, le bord inférieur par le point Ymini et le bord suppérieur par le point Ymaxi.

J'ai testé plein de trucs, mais visiblement il n'y a pas de concordance entre les coordonnées que l'on entre dans une commande du type :

Code:

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 50, 50).Select

et les coordonnées du graphique (dans mon repère diamètre-épaisseur).

J'ai bien pensé récupérer les coordonnées de la souris en cliquand sur deux points caractéristiques pour ensuite faire un produit en croix... mais là encore ça ne donne rien car la fonction :
Code:

1 2 Private Sub Chart_MouseDown(ByVal Button As Long, _ ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
me renvoit des X et Y qui n'on là encore rien à voir avec les coordonnées ni du graphe, ni de la fonction de tracé...

Auriez vous des idées svp ?

Bonjour et bienvenue.

Le coin supérieur gauche d'un rectangle (Xg,Yg) est défini par rapport au point supérieur gauche de la feuille (0f,0f).

A l'intérieur du graphique, les coordonnées sont calculées par rapport au point supérieur du graphique qui est (0g,0g). Le point (0g,0g) est donc à Xg du bord gauche de la feuille et à Yg du bord supérieur de la feuille.

A l'intérieur du graphique, on peut utiliser les top et les left des axes X et Y. On peut également obtenir les valeurs maximales sur ces axes. Le pas de progression sur chaque axe est donc égal à:
pour l'axe des x, la largeur de cet axe / la valeur maximale de l'axe
pour l'axe des y, la hauteur de cet axe / la valeur maximale de l'axe

Le point supérieur gauche du rectangle souhaité sera donc décalé par rapport au coin supérieur gauche de la zone de traçage:
vers la droite d'une valeur correspondant au x minimum * pas X
vers le bas d'une valeur correspondant à (valeur maximale Y - Y maximum) * pas Y

On ajoute 4 de décalage car cela correspond à la marge du cadre des étiquettes des X et des Y.

Voici un code qui trace un cadre délimitant les valeurs d'une série voulue. J'ai mis une illustration pour situer le contexte de l'exemple.

Il faut noter que, si tu travailles en 2007, .DrawingObject n'est pas nécessaire, mais ne gêne pas pour la portabilité du 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 Sub DessinerCadre() Dim Cadre_Graphique As Shape Dim Cadre_Serie As Shape Dim Unite_X As Double, Unite_y As Double Dim Cadre_Left As Double, Cadre_Top As Double Dim X_Minimum As Double, X_Maximum As Double Dim Y_Minimum As Double, Y_Maximum As Double Dim Position_X_Min As Double, Largeur_X As Double Dim Position_Y_Min As Double, Hauteur_Y As Double Dim Position_X_0 As Double Set Cadre_Graphique = Feuil1.Shapes("graphique 1") ' Initialisation des valeurs des séries X_Minimum = Evaluate("SMALL(A2:A14*(NOT(ISBLANK(B2:B14))),COUNTBLANK(B2:B14)+1)") X_Maximum = Evaluate("MAX(A2:A14*NOT(ISBLANK(B2:B14)))") Y_Minimum = Evaluate("min(b2:b14)") Y_Maximum = Evaluate("max(b2:b14)") ' Calcul du pas d'unité pour x et Y Unite_X = Cadre_Graphique.DrawingObject.Chart.Axes(xlCategory).Width / Cadre_Graphique.DrawingObject.Chart.Axes(xlCategory).MaximumScale Unite_y = Cadre_Graphique.DrawingObject.Chart.Axes(xlValue).Height / Cadre_Graphique.DrawingObject.Chart.Axes(xlValue).MaximumScale ' Calcul des dimensions du rectangle Largeur_X = (X_Maximum - X_Minimum) * Unite_X Hauteur_Y = (Y_Maximum - Y_Minimum) * Unite_y ' Position du point superieur gauche du rectangle Cadre_Left = Cadre_Graphique.Left + Cadre_Graphique.DrawingObject.Chart.Axes(xlCategory).Left + 4 + (X_Minimum * Unite_X) Cadre_Top = Cadre_Graphique.Top + Cadre_Graphique.DrawingObject.Chart.Axes(xlValue).Top + 4 + (Cadre_Graphique.DrawingObject.Chart.Axes(xlValue).MaximumScale - Y_Maximum) * Unite_y ' Tracé du cadre Set Cadre_Serie = Feuil1.Shapes.AddShape(msoShapeRectangle, Cadre_Left, Cadre_Top, Largeur_X, Hauteur_Y) Cadre_Serie.Line.Weight = 0 Cadre_Serie.Fill.Transparency = 1 End Sub
http://fauconnier.developpez.com/for...queencadre.png

18/04/2010, 16h27
boby1

Bonsoir,

Je pensais parvenir facilement à adapter le code pour faire la même chose sur un graphique placé sur un onglet à part (donc plus sur une feuille de calcul), hors je bloque...

J'ai tenté d'enlever la définition du "cadre_graphique" vu qu'il est maintenant sur sa propre page, puis d'utiliser des appel "ActiveChart"... mais je dois être encore bien loins du compte...

Puis-je encore solliciter votre aide Pierre svp ?

Il faut adapter certaines lignes.

Les drawingobject.chart ne doivent plus être utilisés.

Les "+4" ne doivent plus être utilisés, et les "cadre_graphique.top" et "cadre_graphique.left" non plus, puisque l'on part forcément de 0.

J'ai adapté les formules du evaluate pour ajouter le nom de la feuille, de façon à ne pas planter si la feuille graphique est active.

Le cadre souhaité s'ajoute sur la feuille graphique

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
Sub DessinerCadre1()
  Dim Cadre_Graphique As Chart
  Dim Cadre_Serie As Shape
  Dim Unite_X As Double, Unite_y As Double
  Dim Cadre_Left As Double, Cadre_Top As Double
  Dim X_Minimum As Double, X_Maximum As Double
  Dim Y_Minimum As Double, Y_Maximum As Double
  Dim Position_X_Min As Double, Largeur_X As Double
  Dim Position_Y_Min As Double, Hauteur_Y As Double
  Dim Position_X_0 As Double
 
  Set Cadre_Graphique = Graph1
 
  ' Initialisation des valeurs des séries
  X_Minimum = Evaluate("SMALL(feuil1!A2:A14*(NOT(ISBLANK(feuil1!B2:B14))),COUNTBLANK(feuil1!B2:B14)+1)")
  X_Maximum = Evaluate("MAX(feuil1!A2:A14*NOT(ISBLANK(feuil1!B2:B14)))")
  Y_Minimum = Evaluate("min(feuil1!b2:b14)")
  Y_Maximum = Evaluate("max(feuil1!b2:b14)")
 
  ' Calcul du pas d'unité pour x et Y
  Unite_X = Cadre_Graphique.Axes(xlCategory).Width / Cadre_Graphique.Axes(xlCategory).MaximumScale
  Unite_y = Cadre_Graphique.Axes(xlValue).Height / Cadre_Graphique.Axes(xlValue).MaximumScale
 
  ' Calcul des dimensions du rectangle
  Largeur_X = (X_Maximum - X_Minimum) * Unite_X
  Hauteur_Y = (Y_Maximum - Y_Minimum) * Unite_y
 
  ' Position du point superieur gauche du rectangle
  Cadre_Left = Cadre_Graphique.Axes(xlCategory).Left + (X_Minimum * Unite_X)
  Cadre_Top = Cadre_Graphique.Axes(xlValue).Top + (Cadre_Graphique.Axes(xlValue).MaximumScale - Y_Maximum) * Unite_y
 
 
  Set Cadre_Serie = Graph1.Shapes.AddShape(msoShapeRectangle, Cadre_Left, Cadre_Top, Largeur_X, Hauteur_Y)
  Cadre_Serie.Line.Weight = 0
  Cadre_Serie.Fill.Transparency = 1
End Sub