variation de taille des cellules

[ladeck]

bonjour à tous

je voulais vous demandez si il était possible de faire varier la taille des cellules colorées de l'exemple ci-joint en fonction de la valeur de celle-ci.
vous en remerciant par avance
bon courage à tous

 

[Lolote83]

Re : variation de taille des cellules

Salut Ladeck,
En passant par un simple graphique en histogramme empilé, cela devrait correspondre à tes attentes.
Voir ici
@+ Lolote83

 

[ladeck]

Re : variation de taille des cellules

Hello
J avais essaye mais pas parvenu, pourtant simple mais je dois rencontrer un probleme, les series ne s emplilent pas
Je vais essayer une dois de plus
Merci pour le devouement

 

[job75]

Re : variation de taille des cellules

Bonjour ladeck, Lolote83, le forum,

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

Private Sub Worksheet_Calculate()
'adaptez les cellules M4 J4 J5 M17 J17 J18
Dim h#

Application.EnableEvents = False

Me.Shapes("Spinner 4").ControlFormat.Max = [M4]
h = [M4].MergeArea.Height
Me.Shapes("ZoneTexte 1").Top = [M4].Top
Me.Shapes("ZoneTexte 1").Height = h * [J4] / IIf([M4], [M4], 1)
Me.Shapes("ZoneTexte 2").Top = [M4].Top + Me.Shapes("ZoneTexte 1").Height
Me.Shapes("ZoneTexte 2").Height = h * [J5] / IIf([M4], [M4], 1)

Me.Shapes("Compteur 1").ControlFormat.Max = [M17]
h = [M17].MergeArea.Height
Me.Shapes("ZoneTexte 3").Top = [M17].Top
Me.Shapes("ZoneTexte 3").Height = h * [J17] / IIf([M17], [M17], 1)
Me.Shapes("ZoneTexte 4").Top = [M17].Top + Me.Shapes("ZoneTexte 3").Height
Me.Shapes("ZoneTexte 4").Height = h * [J18] / IIf([M17], [M17], 1)

Application.EnableEvents = True

End Sub

Adaptez les formules en J27 M27 J29, je n'ai pas compris ce que vous voulez.

A+

 

[job75]

Re : variation de taille des cellules

Re,

Bon, je pense avoir compris vos formules, j'ai modifié la macro en ajoutant [J5] à [M17] :

Private Sub Worksheet_Calculate()
'adaptez les cellules M4 J4 J5 M17 J17 J18
Dim h#

Application.EnableEvents = False

Me.Shapes("Spinner 4").ControlFormat.Max = [M4]
h = [M4].MergeArea.Height
Me.Shapes("ZoneTexte 1").Top = [M4].Top
Me.Shapes("ZoneTexte 1").Height = h * [J4] / IIf([M4], [M4], 1)
Me.Shapes("ZoneTexte 2").Top = [M4].Top + Me.Shapes("ZoneTexte 1").Height
Me.Shapes("ZoneTexte 2").Height = h * [J5] / IIf([M4], [M4], 1)

Me.Shapes("Compteur 1").ControlFormat.Max = [J5] + [M17]
h = [M17].MergeArea.Height
Me.Shapes("ZoneTexte 3").Top = [M17].Top
Me.Shapes("ZoneTexte 3").Height = h * [J17] / IIf([J5] + [M17], [J5] + [M17], 1)
Me.Shapes("ZoneTexte 4").Top = [M17].Top + Me.Shapes("ZoneTexte 3").Height
Me.Shapes("ZoneTexte 4").Height = h * [J18] / IIf([J5] + [M17], [J5] + [M17], 1)

Application.EnableEvents = True

End Sub

Fichier (2).

A+

 

[job75]

Re : variation de taille des cellules

Re,

Pour que les chiffres soient lisibles, imposer une hauteur minimum et une hauteur maximum :

Private Sub Worksheet_Calculate()
'adaptez les cellules M4 J4 J5 M17 J17 J18
Dim h#, h1#

Application.EnableEvents = False

Me.Shapes("Spinner 4").ControlFormat.Max = [M4]
h = [M4].MergeArea.Height
h1 = h * [J4] / IIf([M4], [M4], 1)
Me.Shapes("ZoneTexte 1").Top = [M4].Top
Me.Shapes("ZoneTexte 1").Height = IIf(h1 < 10, 10, IIf(h1 > h - 10, h - 10, h1))
Me.Shapes("ZoneTexte 2").Top = [M4].Top + Me.Shapes("ZoneTexte 1").Height
Me.Shapes("ZoneTexte 2").Height = h - Me.Shapes("ZoneTexte 1").Height

Me.Shapes("Compteur 1").ControlFormat.Max = [J5] + [M17]
h = [M17].MergeArea.Height
h1 = h * [J17] / IIf([J5] + [M17], [J5] + [M17], 1)
Me.Shapes("ZoneTexte 3").Top = [M17].Top
Me.Shapes("ZoneTexte 3").Height = IIf(h1 < 10, 10, IIf(h1 > h - 10, h - 10, h1))
Me.Shapes("ZoneTexte 4").Top = [M17].Top + Me.Shapes("ZoneTexte 3").Height
Me.Shapes("ZoneTexte 4").Height = h - Me.Shapes("ZoneTexte 3").Height

Application.EnableEvents = True

End Sub

Fichier (3).

Nota : "Fonds" prend un "s" au singulier comme au pluriel...

A+