Pessoal, boa noite!
Preciso da ajuda de vocês. No VBA, este script abaixo funciona SOMENTE quando eu altero a célula diretamente, digitando e apertando enter.
As células E155:E201, contem valores de acordo com o que é selecionado em uma linha do tempo..
Como faço para que o Worksheet_Change realize a alteração de cor nas formas, sem precisar DIGITAR (F2 > ENTER) o valor na célula, apenas pela modificação automática dos valores de acordo com a linha do tempo?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E157")) Is Nothing Then
With ActiveSheet.Shapes("Oval 1").Fill.ForeColor
Select Case Target.Value
Case Is < 0: .RGB = RGB(255, 0, 0)
Case Is < 0.05: .RGB = RGB(255, 255, 0)
Case Is <= 0.1: .RGB = RGB(0, 255, 0)
Case Else: .RGB = RGB(0, 255, 0)
End Select
End With
ActiveSheet.Shapes("Oval 1").Fill.Solid
End If
If Not Intersect(Target, Range("E201")) Is Nothing Then
With ActiveSheet.Shapes("Oval 2").Fill.ForeColor
Select Case Target.Value
Case Is < 0: .RGB = RGB(255, 0, 0)
Case Is < 0.05: .RGB = RGB(255, 255, 0)
Case Is <= 0.1: .RGB = RGB(0, 255, 0)
Case Else: .RGB = RGB(0, 255, 0)
End Select
End With
ActiveSheet.Shapes("Oval 2").Fill.Solid
End If
If Not Intersect(Target, Range("E192")) Is Nothing Then
With ActiveSheet.Shapes("Oval 3").Fill.ForeColor
Select Case Target.Value
Case Is < 0: .RGB = RGB(255, 0, 0)
Case Is < 0.05: .RGB = RGB(255, 255, 0)
Case Is <= 0.1: .RGB = RGB(0, 255, 0)
Case Else: .RGB = RGB(0, 255, 0)
End Select
End With
ActiveSheet.Shapes("Oval 3").Fill.Solid
End If
If Not Intersect(Target, Range("E195")) Is Nothing Then
With ActiveSheet.Shapes("Oval 4").Fill.ForeColor
Select Case Target.Value
Case Is < 0: .RGB = RGB(255, 0, 0)
Case Is < 0.05: .RGB = RGB(255, 255, 0)
Case Is <= 0.1: .RGB = RGB(0, 255, 0)
Case Else: .RGB = RGB(0, 255, 0)
End Select
End With
ActiveSheet.Shapes("Oval 4").Fill.Solid
End If
If Not Intersect(Target, Range("E174")) Is Nothing Then
With ActiveSheet.Shapes("Oval 5").Fill.ForeColor
Select Case Target.Value
Case Is < 0: .RGB = RGB(255, 0, 0)
Case Is < 0.05: .RGB = RGB(255, 255, 0)
Case Is <= 0.1: .RGB = RGB(0, 255, 0)
Case Else: .RGB = RGB(0, 255, 0)
End Select
End With
ActiveSheet.Shapes("Oval 5").Fill.Solid
End If
If Not Intersect(Target, Range("E186")) Is Nothing Then
With ActiveSheet.Shapes("Oval 6").Fill.ForeColor
Select Case Target.Value
Case Is < 0: .RGB = RGB(255, 0, 0)
Case Is < 0.05: .RGB = RGB(255, 255, 0)
Case Is <= 0.1: .RGB = RGB(0, 255, 0)
Case Else: .RGB = RGB(0, 255, 0)
End Select
End With
ActiveSheet.Shapes("Oval 6").Fill.Solid
End If
End Sub
Postado : 22/12/2015 3:56 pm