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
sans son image qui est du coup beaucoup plus petit !
@ bientôt
LouReeD
Une solution :
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 :
Voici le classeur en retour :
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
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.