Excel VBA Sub ne s'exécute pas lorsque la cellule cible est remplie avec la valeur de la cellule de référence

Question

Cela fonctionne très bien pour ce que je veux qu'il fasse lorsque je saisis manuellement la valeur de «b37» mais lorsque je mets «= c20», par exemple, dans «b37», rien ne se passe. Comment puis-je faire en sorte que cela fonctionne lorsque la valeur dans la cellule référencée, "c20" change au lieu de saisir manuellement une valeur pour "b37"? Merci!

Sub Worksheet_Change(ByVal target As Range)
    If Intersect(target, Range("b37")) Is Nothing Then Exit Sub
    If IsNumeric(target.Value) Then
        If target.Value < 0.95 Then
            ActiveSheet.Shapes("Straight Connector 1").Line.ForeColor.RGB = vbRed
        ElseIf target.Value >= 0.95 And target.Value < 1 Then
            ActiveSheet.Shapes("Straight Connector 1").Line.ForeColor.RGB = vbGreen
        Else
            ActiveSheet.Shapes("Straight Connector 1").Line.ForeColor.RGB = vbYellow
        End If
    End If
End Sub

Answer 1

Si vous devez réagir à un calcul et non à une valeur saisie manuellement, vous pouvez utiliser l' worksheet_calculateévénement.

Private Sub Worksheet_Calculate()
    Dim v, clr As Long

    v = Me.Range("B37").value
    If not isnumeric(v) or len(v) = 0 then exit sub

    If v < 0.95 Then
        clr = vbRed
    ElseIf v >= 0.95 And v < 1 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    Me.Shapes("Straight Connector 1").Line.ForeColor.RGB = clr
End Sub

EDIT: si vous avez plusieurs cellules à vérifier, vous pouvez factoriser la logique dans un sous-marin séparé et l'appeler pour chaque paire de cellule + forme.

Private Sub Worksheet_Calculate()
    SetLineColor Me.Range("B37"), Me.Shapes("Straight Connector 1")
    SetLineColor Me.Range("B40"), Me.Shapes("Straight Connector 8")
End Sub

Sub SetLineColor(c As Range, ln As Shape)
    Dim v, clr As Long

    v = c.value
    If not isnumeric(v) or len(v) = 0 then exit sub

    If v < 0.95 Then
        clr = vbRed
    ElseIf v >= 0.95 And v < 1 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    ln.Line.ForeColor.RGB = clr
End Sub

Answer 2

Private Sub Worksheet_Calculate()
    SetLineColor1 Me.Range("B37"), Me.Shapes("Line 1")
    SetLineColor2 Me.Range("D35"), Me.Shapes("Line 2")
End Sub

Sub SetLineColor1(c As Range, ln As Shape)
    Dim v, clr As Long

    v = c.Value
    If Not IsNumeric(v) Or Len(v) = 0 Then Exit Sub

    If v < 0.95 Then
        clr = vbRed
    ElseIf v >= 0.95 And v < 1 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    ln.Line.ForeColor.RGB = clr
End Sub
Sub SetLineColor2(c As Range, ln As Shape)
    Dim v, clr As Long

    v = c.Value
    If Not IsNumeric(v) Or Len(v) = 0 Then Exit Sub

    If v < 88 Then
        clr = vbRed
    ElseIf v >= 88 And v < 100 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    ln.Line.ForeColor.RGB = clr
End Sub