Utilizando eventos do Excel - Parte 2

Vamos ver agora outros exemplos, utilizando o evento Worksheet_Change

O objetivo neste exemplo é colorir qualquer célula alterada que esteja no intervalo A1:C50 da planilha. A célula ficará colorida em vermelho com a fonte formatada para a cor branca.


Private Sub Worksheet_Change(ByVal Target As Range)


Dim rgFormat As Range
Dim rgInter  As Range


'Intervalo dentro do qual será realizada a formatação
Set rgFormat = ActiveSheet.[A1:C50]


'É obtida a intersecção da célula alterada com o intervalo rgFormat
Set rgInter = Application.Intersect(Target, rgFormat)


'Se houver a intersecção, ou seja se Target pertencer ao intervalo
'rgFormat, a célula será colorida de vermelho e a fonte será
'formatada para a cor branca
If Not rgInter Is Nothing Then
Target.Interior.Color = vbRed
Target.Font.Color = vbWhite
End If


End Sub

No próximo exemplo, iremos colocar em letras maiúsculas qualquer valor de texto inserido nas células do intervalo A1:C50. É importante observar a utilização da linha de comando

Application.EnableEvents = False

Como o código altera o conteúdo da célula, é necessário que desabilitemos os eventos, pois caso contrário cria-se um loop infinito, pois a alteração dispara um novo evento.

Também é importante lembrar que os eventos devem ser reabilitados antes do término da execução do código, ou poderemos afetar outras funcionalidades do arquivo.


Private Sub Worksheet_Change(ByVal Target As Range)


Dim rgCaps As Range
Dim rgInter  As Range


'Intervalo dentro do qual será realizada a formatação
Set rgCaps = ActiveSheet.[A1:C50]


'É obtida a intersecção da célula alterada com o intervalo rgChange
Set rgInter = Application.Intersect(Target, rgCaps)


'Se houver a intersecção, ou seja se Target pertencer ao intervalo
'rgChange, os eventos são desabilitados
If Not rgInter Is Nothing Then
Application.EnableEvents = False


'Em seguida o conteúdo de Target é colocado em maiúsculas
Target = UCase(Target)


'Finalmente os eventos são reabilitados
Application.EnableEvents = True


End If


End Sub

[ ]s