Excel VBA Sub no se ejecuta cuando la celda de destino se llena con el valor de la celda de referencia
Nov 24 2020
Esto funciona muy bien para lo que quiero que haga cuando ingreso manualmente el valor para "b37" pero cuando pongo "= c20", por ejemplo, en "b37" no sucede nada. ¿Cómo hago que esto funcione cuando el valor en la celda a la que se hace referencia, "c20" cambia en lugar de ingresar manualmente un valor para "b37"? ¡Gracias!
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
Respuestas
TimWilliams Nov 24 2020 at 19:41
Si necesita reaccionar a un cálculo y no a un valor ingresado manualmente, puede usar el worksheet_calculateevento.
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
EDITAR: si tiene varias celdas para verificar, puede factorizar la lógica en un sub separado y llamarlo para cada par de celda + forma.
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
SackOvergrowth Nov 25 2020 at 17:47
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