optimisé le code d'une barre d'évolution

[gunm]

Bonjour,
je suis débutant dans le domaine mais j'aimerais créé une barre dévolution.
j'ai réussi à en créé une le problème est que le code que j'ai effectuer me parait long. Je ne maitrise pas les boucles...

je partage mon fichier pour qu'on puisse voir mon code.

Ma barre d'évolution se fait bien sur 2 ligne et j'ai besoin de remettre la case en blanc au cas ou je changerais la valeur de mon "nb"
Etant donner que je fait toujours plus un a chaque fois je me dis qu'il doit exister une boucle spécifique.
Cependant ma barre d'évolution s'arrète volontairement a 10. Si mon chiffre est supérieur à 10, mon "nb" sera rouge.

Merci de vos suggestions 🙂

 

[Softmama]

Re : optimisé le code d'une barre d'évolution

Bonsoir,

je te propose ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "A4" Then
  If Target > 10 Then Range("C4:G5").Interior.Color = vbYellow: Exit Sub
  Range("C4:G5").Interior.Color = vbWhite
  If Target < 1 Then Exit Sub
  For t = 1 To Target.Value
    Range("C4:G5").Cells(t).Interior.Color = vbYellow
  Next t
End If
End Sub

Pas besoin d'appuyer sur un bouton, la zone se colorie dès que tu changes la valeur en A4. Cf. fichier joint

 

[gunm]

Re : optimisé le code d'une barre d'évolution

ha oui effectivement le code est beaucoup beaucoup plus court et plus simple

Merci pour cette réponse rapide !

 

[Softmama]

Re : optimisé le code d'une barre d'évolution

Re,

sinon, tu peux aisément modifier un rectangle jaune dont la taille varierait proportionnellement à celle de ta cellule A4. Cf. exemple ci joint.
Le code est :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "A4" Then
  With ActiveSheet.Shapes("Rectangle 1")
    .Height = Range("C9").Height
    .Width = Range("C9:G9").Width * Application.Min(1, Target / 10)
    .Top = Range("C9").Top
    .Left = Range("C9").Left
  End With
End If
End Sub

 

[gunm]

Re : optimisé le code d'une barre d'évolution

re,
sinon comment faire si ma case "A4" est une formule ? du style recherche ou somme ?
j'ai essayer de remplacer le "A4" par une variable exemple "nb".
nb= val(range("a4")
et si je veux remplir de manière à l'envers ? de remplir de gauche à droite, et de bas en haut? j'ai essayer de changer la code au niveau du code " for" mais ca ne donne rien de cohérent.

merci
cdt

 

[Softmama]

Re : optimisé le code d'une barre d'évolution

Re,

En effet dans ce cas, le changement ne survient pas sur la cellule A4, mais sur celles dont elle dépend
Par exemple, si la formule en A4 est : =SOMME(A5:A8)

Il faut alors modifier la macro ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A5:A8")) Is Nothing Then
  If Range("A4") > 10 Then Range("C4:G5").Interior.Color = vbYellow
  Range("C4:G5").Interior.Color = vbWhite
  If Range("A4") < 1 Then Exit Sub
  For t = 1 To Range("A4")
    Range("C4:G5").Cells(t).Interior.Color = vbYellow
  Next t
end Sub

ou par changement de la taille d'un rectangle jaune :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A5:A8")) Is Nothing Then
  With ActiveSheet.Shapes("Rectangle 1")
    .Height = Range("C9").Height
    .Width = Range("C9:G9").Width * Application.Min(1, Range("A4") / 10)
    .Top = Range("C9").Top
    .Left = Range("C9").Left
  End With
End If
End Sub

Vois l'exemple joint

 

[Softmama]

Re : optimisé le code d'une barre d'évolution

re,

de droite à gauche, vois l'exemple :

 

[gunm]

Re : optimisé le code d'une barre d'évolution

super merci! je vais étudier ça

 

[gunm]

Re : optimisé le code d'une barre d'évolution

re, j'ai de nouveau un soucis avec le code :/

En feuille 1 il y a le code qui fonctionne, et en feuille 3 j'ai essayer de le reproduire mais je suis confronter à un problème d'étiquette.
Pourtant je ne fait que changer les valeurs cibles. Je n'arrive pas à comprendre mon erreur

merci