Graphique histogramme empilé avec 2 axes en %

Bonjour,

Je souhaiterais créer un graphique qui présente en ordonnées des valeurs en % selon un histogramme empilé et sur ce même graphique, les abscisses qui auraient comme base de l'histogramme le % du total de l'axe des abscisses.

Je n'arrive pas à gérer la base de l'histogramme empilé pour lui donner les valeurs en rouge sur la photo ci-dessous

Ex :

Merci d'avance pour votre aide

Jean-Philippe

Bonjour,

l'affichage du nom des produits en ordonnée n'est pas possible et ne veut rien dire, ce ne peut être que des valeurs.

sinon voilà ce qu'on peut obtenir par rapport à ce que vous demandez, à adapter au fichier réel:

Cdlt

Bonjour,

Merci pour votre retour

En effet, ma présentation de l'axe des ordonnées n'est pas bonne

L'objectif est effectivement un histogramme empilé 100% en ordonnées

Dans le fichier joint, les trois histogrammes ont la même largeur

Mon problème réside dans le fait d'avoir un axe des abscisses également exprimé en % mais surtout de pouvoir gérer la largeur des histogrammes en fonction de la proportion de l'axe des abscisses

Ce n'est pas l'affichage d'une valeur en abscisse mais bien la largeur de la première colonne histogramme qui doit représenter 60% de l'axe des abscisses

La largeur de la seconde colonne histogramme doit représenter 30% de l'axe des abscisses etc...

Je ne pense pas que ce soit possible via un graphique natif d'Excel mais c'est ce que j'aimerais confirmer et trouver le moyen de bricoler ce type de représentation

Jean-Philippe

Bonjour JP_MICHEL, Arturo83, le forum,

Bon, un peu galère mais je pense que le résultat se rapproche de la demande.

C'est un graphique en aire empilées qui permet d'avoir des largeurs de séries différentes. C'est loin d'être parfait notamment les étiquettes de données qui ne sont pas correctement placées et doublées (?) et surtout les noms des produits (1,2,3) qui sont en fait des "shapes" que je n'ai pas réussi à intégrer. Alors, j'ai bricolé...

Ce qui donne :

Le classeur en pièce jointe :

Bonne soirée à tous.

AL 22

Bonjour,

Solution avec macro, Ici ce n'est pas un graphique, mais des objets dessinés "type rectangle" qui construisent ce pseudo graphique.

De plus il peut accepter d'autres produits et d'autres sociétés.

Les couleurs reportées sur ce graphique sont issues de la ligne 1, cellule "produit", donc si vous changez de couleurs dans ces cellules, elles seront reportées sur le graphique.

A chaque clic sur le bouton, le précédent graphique est détruit entièrement et il s'en crée un nouveau.

le code:

Sub Simili_Graphique()
    Dim DerCol As Long, DerLig As Long, NB_Rect_Tot As Long, NB_Rect_par_Colonne As Long
    Dim Pos_Gauche As Long, Pos_Haut As Long, Couleur As Long
    Dim T_Tot As Double, T_Prod As Double
    Dim Sh As String

    'Suppression des objets dessinés précédemment créés
    For Each img In ActiveSheet.Shapes
        If img.Name <> "Bouton_Graphique" Then img.Delete
    Next
    'Création du cadre extérieur
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 400, 100, 800, 410).Select
    Selection.Name = "Cadre exterieur 1"
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(201, 255, 255)

    'Création du cadre intérieur
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 550, 110, 640, 350).Select
    Selection.Name = "Cadre exterieur 1"

    'déterminer le nombre de rectangles à poser
    DerCol = Range("ZZ1").End(xlToLeft).Column
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    NB_Rect_Tot = (DerCol - 2) * (DerLig - 1)
    NB_Rect_par_Colonne = NB_Rect_Tot / (DerCol - 2)
    Pos_Gauche = 550

    'Création et pose des Rectangles des valeurs
    For i = 2 To DerLig
        Pos_Haut = 110
        T_Tot = Cells(i, "B") ''Evaluation du Pourcentage total par ligne, represente aussi la largeur des rectangles à poser
        Sh = ""
        For j = NB_Rect_par_Colonne To 1 Step -1
            Couleur = Cells(1, j + 2).Interior.Color
            R = CLng(Couleur Mod 256)
            G = CLng((Couleur Mod 65536) / 255)
            B = CLng(Couleur / 65535)

            'Traçage des rectangles "produits_sociétés"
            T_Prod = Cells(i, j + 2) 'Evaluation du Pourcentage du produit par société, représente aussi la hauteur du rectangle à poser
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, Pos_Gauche, Pos_Haut, (640 * T_Tot), (350 * T_Prod)).Select
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B)
            With ActiveSheet
                Sh = .Shapes(ActiveSheet.Shapes.Count).Name
                .Shapes(Sh).TextFrame.Characters.Text = (T_Prod * 100) & "%"
                .Shapes(Sh).TextFrame.Characters.Font.Color = RGB(0, 0, 0)
            End With
            Pos_Haut = Pos_Haut + (350 * T_Prod)
        Next j
        'Traçage des rectangles "Valeurs des abscisses"
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, Pos_Gauche, 110 + 350, (640 * T_Tot), 40).Select
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
        With ActiveSheet
            Sh = .Shapes(ActiveSheet.Shapes.Count).Name
            .Shapes(Sh).TextFrame.Characters.Text = (T_Tot * 100) & "%" & Chr(10) & Cells(i, "A")
            .Shapes(Sh).TextFrame.Characters.Font.Color = RGB(0, 0, 0)
            .Shapes(Sh).TextFrame.Characters.Font.Bold = True
        End With
        Pos_Gauche = Pos_Gauche + (640 * T_Tot)
    Next i

    'création des étiquettes "Produits" en ordonnées
    Haut = 100
    For i = NB_Rect_par_Colonne To 1 Step -1
        Couleur = Cells(1, i + 2).Interior.Color
        R = CLng(Couleur Mod 256)
        G = CLng((Couleur Mod 65536) / 255)
        B = CLng(Couleur / 65535)
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 410, Haut + (Haut / NB_Rect_Tot) * i, 130, 20).Select
        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B)
        With ActiveSheet
            Sh = .Shapes(ActiveSheet.Shapes.Count).Name
            .Shapes(Sh).TextFrame.Characters.Text = Cells(1, i + 2)
            .Shapes(Sh).TextFrame.Characters.Font.Color = RGB(0, 0, 0)
        End With
        Haut = Haut + ((Haut / NB_Rect_par_Colonne) * i)
    Next i
    Range("A1").Select
End Sub

Bonnes fêtes de fin d'année

Cdlt