graphique avec écart

[eastwick]

Bonjour à toutes et tous,
Est-il possible de générer ce type de graphique (voir fichier) avec les informations du tableau ?
Ces informations peuvent changer de place pour vous faciliter le travail.

Je vous remercie.

 

[CISCO]

Re : graphique avec écart

Bonjour

Tu pourras peut être faire quelque chose avec les indications faites là :
https://www.excel-downloads.com/threads/griser-intervalle-entre-2-courbes.20001448/

@ plus

 

[eastwick]

Re : graphique avec écart

Trop complexe pour moi !

 

[eastwick]

Re : graphique avec écart

vraiment personne ? Merci !

 

[CISCO]

Re : graphique avec écart

Bonjour

J'ai essayé, sans résultat totalement concluant. Si j'ai le temps...

@ plus

 

[eastwick]

Re : graphique avec écart

Merci ! je savais que c'était hard !

 

[CISCO]

Re : graphique avec écart

Bonsoir

Une possibilité en pièce jointe.

En réalité, il y a trois aires, la verte au dessus de la bleue, au dessus de l'orange. Pour voir les points utilisés, correspondant à chacune, cliquer dessus.

Si tu veux réutiliser cela pour d'autres valeurs, il faut changer les valeurs en rouge, et au besoin, rajouter ou supprimer des lignes pour forcer l'affichage des abscisses.

@ plus

P.S : Le défaut du système, c'est qu'en bas, tu n'as pas des valeurs distribuées proportionnellement à leur valeur, comme avec le graphique "nuage de points", mais des étiquettes. Si tu écris par exemple 52 au lieu de 60, la nouvelle valeur se placera exactement au même endroit que le 60, alors qu'elle aurait dû se placer un tout petit peu plus à gauche. Dans l'exemple dans le fichier, cela fonctionne bien parce que les étiquettes prises vont de 20 en 20. Je n'ai pas trouvé l'enchaînement des actions et choix à faire pour obtenir un axe des abscisses avec des valeurs distribuées à leur place réelle, et pas comme des étiquettes.

 

[job75]

Re : graphique avec écart

Bonjour eastwick, CISCO,

Voyez le fichier joint avec cette macro dans le code de la feuille :

Private Sub Worksheet_Calculate()
'le tableau T définit les textes et les couleurs des Shapes
Dim s As Shape, p1 As Point, p2 As Point, p3 As Point, p4 As Point, p5 As Point
With ChartObjects(1).Chart
  For Each s In .Shapes 'RAZ
    s.Delete
  Next
  Set p1 = .SeriesCollection(1).Points(1)
  Set p2 = .SeriesCollection(1).Points(2)
  Set p3 = .SeriesCollection(1).Points(3)
  Set p4 = .SeriesCollection(1).Points(4)
  Set p5 = .SeriesCollection(1).Points(5)
  With .Shapes.AddShape(msoShapeRectangle, p1.Left, p4.Top, p2.Left - p1.Left, p1.Top - p4.Top)
    .Line.Visible = msoFalse
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.HorizontalAnchor = msoAnchorCenter
    .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.ObjectThemeColor = 1 'police noire
    .TextFrame2.TextRange.Characters.Text = [T].Cells(1)
    .Fill.ForeColor.RGB = [T].Cells(1, 3).Interior.Color
  End With
  With .Shapes.AddShape(msoShapeRectangle, p2.Left, p4.Top, p3.Left - p2.Left, p1.Top - p4.Top)
    .Line.Visible = msoFalse
    .TextFrame2.Orientation = msoTextOrientationUpward
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.HorizontalAnchor = msoAnchorCenter
    .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.ObjectThemeColor = 1
    .TextFrame2.TextRange.Characters.Text = [T].Cells(2, 1)
    .Fill.ForeColor.RGB = [T].Cells(2, 3).Interior.Color
  End With
  With .Shapes.AddShape(msoShapeRectangle, p1.Left, p5.Top, p3.Left - p1.Left, p4.Top - p5.Top)
    .Line.Visible = msoFalse
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.HorizontalAnchor = msoAnchorCenter
    .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.ObjectThemeColor = 1
    .TextFrame2.TextRange.Characters.Text = [T].Cells(3, 1)
    .Fill.ForeColor.RGB = [T].Cells(3, 3).Interior.Color
  End With
End With
End Sub

3 Shapes (rectangles) sont créées dans le graphique quand la feuille est recalculée.

A+

 

[job75]

Re : graphique avec écart

Re,

Une fois les Shapes créées on peut les laisser en place et alléger la macro :

Private Sub Worksheet_Calculate()
'le tableau T définit les textes et les couleurs des Shapes
Dim p1 As Point, p2 As Point, p3 As Point, p4 As Point, p5 As Point
With ChartObjects(1).Chart
  Set p1 = .SeriesCollection(1).Points(1)
  Set p2 = .SeriesCollection(1).Points(2)
  Set p3 = .SeriesCollection(1).Points(3)
  Set p4 = .SeriesCollection(1).Points(4)
  Set p5 = .SeriesCollection(1).Points(5)
  With .Shapes("Rectangle 1")
    .Left = p1.Left: .Top = p4.Top
    .Width = p2.Left - p1.Left: .Height = p1.Top - p4.Top
    .TextFrame2.TextRange.Characters.Text = [T].Cells(1)
    .Fill.ForeColor.RGB = [T].Cells(1, 3).Interior.Color
  End With
  With .Shapes("Rectangle 2")
    .Left = p2.Left: .Top = p4.Top
    .Width = p3.Left - p2.Left: .Height = p1.Top - p4.Top
    .TextFrame2.Orientation = msoTextOrientationUpward 'msoTextOrientationHorizontal
    .TextFrame2.TextRange.Characters.Text = [T].Cells(2, 1)
    .Fill.ForeColor.RGB = [T].Cells(2, 3).Interior.Color
  End With
  With .Shapes("Rectangle 3")
    .Left = p1.Left: .Top = p5.Top
    .Width = p3.Left - p1.Left: .Height = p4.Top - p5.Top
    .TextFrame2.TextRange.Characters.Text = [T].Cells(3, 1)
    .Fill.ForeColor.RGB = [T].Cells(3, 3).Interior.Color
  End With
End With
End Sub

Fichier (2).

A+

 

[job75]

Re : graphique avec écart

Re,

Il me semble judicieux de mettre en AB16 la formule :

=REPT(AB4;ET(AC4<=AC5;AD4<=AD5))&REPT(AB5;ET(AC4>AC5;AD4>AD5))

Si le minimum de AC4:AC5 et le minimum de AD4:AD5 ne sont pas sur la même ligne il ne faut pas de libellé dans la zone verte.

Fichier (3).

Bonne soirée.

 

[job75]

Re : graphique avec écart

Re,

En tripotant les données d'origine je découvre un phénomène curieux.

Il est mieux de modifier les dimensions des Shapes avant de les positionner :

Private Sub Worksheet_Calculate()
'le tableau T définit les textes et les couleurs des Shapes
Dim p1 As Point, p2 As Point, p3 As Point, p4 As Point, p5 As Point
With ChartObjects(1).Chart
  Set p1 = .SeriesCollection(1).Points(1)
  Set p2 = .SeriesCollection(1).Points(2)
  Set p3 = .SeriesCollection(1).Points(3)
  Set p4 = .SeriesCollection(1).Points(4)
  Set p5 = .SeriesCollection(1).Points(5)
  With .Shapes("Rectangle 1")
    .Width = p2.Left - p1.Left: .Height = p1.Top - p4.Top 'dimensionner d'abord
    .Left = p1.Left: .Top = p4.Top
    .TextFrame2.TextRange.Characters.Text = [T].Cells(1)
    .Fill.ForeColor.RGB = [T].Cells(1, 3).Interior.Color
  End With
  With .Shapes("Rectangle 2")
    .Width = p3.Left - p2.Left: .Height = p1.Top - p4.Top 'dimensionner d'abord
    .Left = p2.Left: .Top = p4.Top
    .TextFrame2.Orientation = msoTextOrientationUpward 'msoTextOrientationHorizontal
    .TextFrame2.TextRange.Characters.Text = [T].Cells(2, 1)
    .Fill.ForeColor.RGB = [T].Cells(2, 3).Interior.Color
  End With
  With .Shapes("Rectangle 3")
    .Width = p3.Left - p1.Left: .Height = p4.Top - p5.Top 'dimensionner d'abord
    .Left = p1.Left: .Top = p5.Top
    .TextFrame2.TextRange.Characters.Text = [T].Cells(3, 1)
    .Fill.ForeColor.RGB = [T].Cells(3, 3).Interior.Color
  End With
End With
End Sub

Fichier (4).

Edit : pour comprendre ce que j'ai découvert, tester les fichiers (3) et (4) en mettant 100 puis 220 en AD5.

Bonne nuit.

 

[job75]

Re : graphique avec écart

Bonjour le fil, le forum,

Pour éviter d'effacer les formules il est bon de protéger la feuille, dans ThisWorkbook :

Private Sub Workbook_Open()
Feuil1.Protect "TOTO", UserInterfaceOnly:=True, AllowFormattingCells:=True
End Sub

Et pour éviter l'invite à la fermeture :

Private Sub Worksheet_Calculate()
'---
ThisWorkbook.Saved = True 'évite l'invite à la fermeture
End Sub

Fichier (5).

Bonne journée.

 

[CISCO]

Re : graphique avec écart

Bonjour à tous, bonjour Job75

@ Job75 : Quel travail ! Sur ton dernier fichier, lorsque j'essaye de changer une valeur dans le tableau modifiable, j'ai une erreur et le déboggueur surligne la ligne 12 -->.Width = p2.Left - p1.Left:

@ plus

 

[job75]

Re : graphique avec écart

Bonjour CISCO,

Chez moi il n'y avait pas de problème, mais je viens de modifier mon post #12, quid maintenant ?

A+

 

[CISCO]

Re : graphique avec écart

Bonjour à tous, rebonjour job75

Non, cela ne change rien. J'ai le message "Erreur 438" dès l'ouverture du fichier puis, dans la macro, le début de la ligne 12 surligné. Il faudrait que j'essaye sur un autre ordi pour voir si cela ne vient pas de la version d'excel utilisé (2007) ou de petits bugs liés à mon ordi.

@ plus