Bonjour à tous,
Voila j'ai créer une macro récément qui positionne un shapes (une fléche) lorsque la valeur de la cellule change, ceci marche à merveille (et je suis trés content car ca m'as pris la tête ) , mon souci actuellement c'est que je dois rentrer manuellement la valeur dans la cellule à chaque repositionnement de la fléche,comme la cellule contient une formule( basique somme) et la valeur change en fonction d autres cellules , je voudrai que cette étape se fasse automatiquement à chaque changement de valeur (sans que je la fasse rentrer par moi meme)
voici mon code :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("BE36:BE38,BE11:BE13")) Is Nothing Then
'Vérification des valeurs saisies (ie respect de l'intervalle min-max)
If Target < Range("BE37") Then
MsgBox "Valeur inférieure à la valeur minimale", vbOKOnly + vbCritical
If Target.Address <> "$BE$36" Then Target = Range("BE37")
Exit Sub
End If
If Target > Range("BE36") Then
MsgBox "Valeur supérieure à la valeur maximale", vbOKOnly + vbCritical
If Target.Address <> "$BE$37" Then Target = Range("BE36")
Exit Sub
End If
If Range("BE36") = Range("BE37") Then Exit Sub
' Affichage des valeurs intermédiaires pour l'échelle de la jauge
With ActiveSheet
.Shapes("Ech1").TextFrame.Characters.Text = Range("BE37")
.Shapes("Ech2").TextFrame.Characters.Text = Range("BE37") + (Range("BE36") - Range("BE37")) / 4
.Shapes("Ech3").TextFrame.Characters.Text = Range("BE37") + (Range("BE36") - Range("BE37")) / 2
.Shapes("Ech4").TextFrame.Characters.Text = Range("BE37") + 3 * (Range("BE36") - Range("BE37")) / 4
.Shapes("Ech5").TextFrame.Characters.Text = Range("BE36")
End With
PositionFlèches
End If
End Sub
Merci d'avance pour vos réponses et votre attention
Cdt
Voila j'ai créer une macro récément qui positionne un shapes (une fléche) lorsque la valeur de la cellule change, ceci marche à merveille (et je suis trés content car ca m'as pris la tête ) , mon souci actuellement c'est que je dois rentrer manuellement la valeur dans la cellule à chaque repositionnement de la fléche,comme la cellule contient une formule( basique somme) et la valeur change en fonction d autres cellules , je voudrai que cette étape se fasse automatiquement à chaque changement de valeur (sans que je la fasse rentrer par moi meme)
voici mon code :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("BE36:BE38,BE11:BE13")) Is Nothing Then
'Vérification des valeurs saisies (ie respect de l'intervalle min-max)
If Target < Range("BE37") Then
MsgBox "Valeur inférieure à la valeur minimale", vbOKOnly + vbCritical
If Target.Address <> "$BE$36" Then Target = Range("BE37")
Exit Sub
End If
If Target > Range("BE36") Then
MsgBox "Valeur supérieure à la valeur maximale", vbOKOnly + vbCritical
If Target.Address <> "$BE$37" Then Target = Range("BE36")
Exit Sub
End If
If Range("BE36") = Range("BE37") Then Exit Sub
' Affichage des valeurs intermédiaires pour l'échelle de la jauge
With ActiveSheet
.Shapes("Ech1").TextFrame.Characters.Text = Range("BE37")
.Shapes("Ech2").TextFrame.Characters.Text = Range("BE37") + (Range("BE36") - Range("BE37")) / 4
.Shapes("Ech3").TextFrame.Characters.Text = Range("BE37") + (Range("BE36") - Range("BE37")) / 2
.Shapes("Ech4").TextFrame.Characters.Text = Range("BE37") + 3 * (Range("BE36") - Range("BE37")) / 4
.Shapes("Ech5").TextFrame.Characters.Text = Range("BE36")
End With
PositionFlèches
End If
End Sub
Merci d'avance pour vos réponses et votre attention
Cdt