Notifications
Clear all

Worksheet_Change

5 Posts
2 Usuários
0 Reactions
853 Visualizações
(@hbraga)
Posts: 9
Active Member
Topic starter
 

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
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Alterações de valores "via" formula, não "dispara" o evento Change da planilha. Talvez deva considerar/experimentar outros eventos de planilha, como por exemplo o evento Calculate.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 23/12/2015 7:57 am
(@hbraga)
Posts: 9
Active Member
Topic starter
 

Reinaldo,

Já tentei com o Calculate mas não atendeu. O mais próximo que cheguei do que preciso foi com o SelectionChange, onde preciso apenas selecionar a célula para ativar a condição do script e alterar a cor da FORMA, mas mesmo assim continua "manual" o processo.

 
Postado : 23/12/2015 8:58 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Pois é, não sei se reparou, mas alterando o evento para o calculate seu código também deve ser alterado, "não há mais" o intersect e o Target.
Assim sua rotina devera ser algo +/- asism:

....
With ActiveSheet.Shapes("Oval 1").Fill.ForeColor
    Select Case Range("E157").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.....

Similar para as demias shapes involvidas

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 23/12/2015 10:39 am
(@hbraga)
Posts: 9
Active Member
Topic starter
 

Reinado,

Funcionou. Ficou ótimo. Todas as Forms estão mudando de cor automaticamente, quando mudo a linha do tempo.

Obrigado pela ajuda!

 
Postado : 23/12/2015 3:10 pm