Barre de progression

Bonjour,

Afin de mesurer l'écart des dépenses par rapport au budget, j'aurai aimé faire un tableau de bord dans lequel il y aurait une barre de donnée (reflétant la dépense réalisé) avec une un trait (reflétant les objectifs) .

Cependant je ne sais pas comment faire pour mettre les deux dans la même cellules.

Merci d'avances de tout cœur pour votre aide

Bonsoir,

voici ma solution :

insertion d'un graphique "barre" mais en mettant les deux données l'une au dessus de l'autre, et en mettant l'objectif en dessous.

Du coup le réel varie, la barre s'agrandie et masque au fur et à mesure celle de l'objectif...

Seul bémol c'est si le réel dépasse l'objectif, cela ne ce voit pas directement...

Le fichier

11test-graphique.xlsx (15.91 Ko)

sans son image qui est du coup beaucoup plus petit !

@ bientôt

LouReeD

Une solution :

18test-graphique.xlsx (15.10 Ko)

une MFC qui passe en "vert" les réels qui sont au delà de l'objectif...

@ bientôt

LouReeD

Bonjour,

Une autre piste avec traçage de Shapes qui ressemble à ça :

graph

Voici le classeur en retour :

34test-graphique.xlsm (26.43 Ko)

dont le code est (pour ceux qui ne veulent pas télécharger le classeur) :

Sub Tracer()

    Dim Fe As Worksheet
    Dim Rect As Shape
    Dim Trait As Shape
    Dim Texte As Shape
    Dim Tbl()
    Dim Budget As Long
    Dim I As Long
    Dim HautRect As Integer
    Dim GaucheRect As Long
    Dim EpaisRect As Integer
    Dim HautTrait As Integer
    Dim GaucheTrait As Long
    Dim EpaisTrait As Integer
    Dim PosHaut As Integer
    Dim Marge As Integer
    Dim LargeTexte As Integer
    Dim Coeff As Single

    GaucheRect = 650
    HautRect = 110
    EpaisRect = 10
    EpaisTrait = 1
    HautTrait = 30
    Marge = 30
    LargeTexte = 50

    Coeff = 0.0005 'coefficient pour réduire la longueur

    Set Fe = ActiveSheet

    'supprime tous les Shapes avant de créer le graphique
    Effacer

    ReDim Tbl(1 To 3, 1 To 5)

    'tableau à deux dimensions dont la première contient les sommes réelles et la seconde les budgets aloués
    With Worksheets("Feuil1")

        Tbl(1, 1) = .Range("E10").Value: Tbl(2, 1) = .Range("F10").Value: Tbl(3, 1) = "Atelier C"
        Tbl(1, 2) = .Range("E11").Value: Tbl(2, 2) = .Range("F11").Value: Tbl(3, 2) = "Atelier B"
        Tbl(1, 3) = .Range("E12").Value: Tbl(2, 3) = .Range("F12").Value: Tbl(3, 3) = "Atelier A"
        Tbl(1, 4) = .Range("E13").Value: Tbl(2, 4) = .Range("F13").Value: Tbl(3, 4) = "Atelier E"
        Tbl(1, 5) = .Range("E14").Value: Tbl(2, 5) = .Range("F14").Value: Tbl(3, 5) = "Atelier D"

    End With

    'position de départ du premier segment
    PosHaut = HautRect + EpaisRect

    For I = 1 To UBound(Tbl, 2)

        'longueur du budget aloué
        Budget = Tbl(2, I) * Coeff

        'rectangle horizontal
        Set Rect = Fe.Shapes.AddShape(1, GaucheRect, PosHaut, Budget, EpaisRect)

        GaucheTrait = GaucheRect + Tbl(1, I) * Coeff 'doit aussi être multiplié par le coefficient

        'trait vertical symbolisant la somme engagée
        Set Trait = Fe.Shapes.AddShape(1, GaucheTrait, (PosHaut + EpaisRect / 2) - HautTrait / 2, EpaisTrait, HautTrait)

        'colore le trait en rounge si le budget aloué est dépassé
        If Tbl(1, I) > Tbl(2, I) Then

            Trait.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Trait.Line.ForeColor.RGB = RGB(255, 0, 0)

        End If

        'zone de texte pour les noms d'ateliers
        Set Texte = Fe.Shapes.AddLabel(1, 1, PosHaut, 1, EpaisRect)

        'sans marge, et transparent pour le fond et les bordures
        With Texte

            With .TextFrame

                '.Orientation = msoTextOrientationHorizontal
                .Characters.Text = Tbl(3, I) & "(" & Tbl(2, I) & ")"
                .AutoSize = True
                .MarginLeft = 0
                .MarginRight = 0
                .MarginTop = 0
                .MarginBottom = 0

            End With

            .Left = GaucheRect - .Width - 5
            .Top = PosHaut
            .Fill.Transparency = 1
            .Line.Transparency = 1

        End With

        'zone de texte pour les sommes réelles engagées
        Set Texte = Fe.Shapes.AddLabel(1, 1, PosHaut, 1, EpaisRect)

        'sans marge, et transparent pour le fond et les bordures
        With Texte

            If Tbl(1, I) > Tbl(2, I) Then

                .TextEffect.FontBold = msoCTrue
                .TextEffect.FontItalic = msoCTrue
                .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)

            End If

            With .TextFrame

                '.Orientation = msoTextOrientationHorizontal
                .Characters.Text = Tbl(1, I)
                .AutoSize = True
                .MarginLeft = 0
                .MarginRight = 0
                .MarginTop = 0
                .MarginBottom = 0

            End With

            .Left = GaucheTrait + EpaisTrait + 5
            .Top = PosHaut
            .Fill.Transparency = 1
            .Line.Transparency = 1

        End With

        'incrémente
        PosHaut = PosHaut + Marge

    Next I

End Sub

Sub Effacer()

    Dim S As Shape

    For Each S In ActiveSheet.Shapes
        If S.Name <> "BtnTracer" Then S.Delete
    Next S

End Sub
34test-graphique.xlsm (26.43 Ko)

Bonjour,

Je vous remercie pour toutes vos réponses.

Je pense que l'idée de Theze est intéressante cependant très compliqué pour quelqu'un qui n'est pas expert en VBA comme moi..

Après plusieurs recherche, je pense avoir trouvé une solution qui conviendrait à mes besoins, ce serait d'insérer un graphique en barre empilés pour les dépenses réalisés et d'insérer une barre d'erreur qui correspondrait aux objectifs.

Cependant je n'arrive pas à superposé correctement les deux et je n'arrive pas a connecté mon tableau (avec mes données) et le graphique pour que lorsque je change mes données mon graphique évolue.

Si quelqu'un a une solution je suis preneur.

Je vous ai joins mon fichier pour mieux comprendre

Je vous remercie d'avance.

13classeur1.xlsx (22.45 Ko)
Rechercher des sujets similaires à "barre progression"