O Excel tem um grande número de shapes disponíveis que permitem melhorar
graficamente as folhas de cálculo. São muito úteis e muito utilizadas, permitindo
colocar comentários, chamadas de atenção, setas, estrelas, etc.
São tantas vezes utilizadas que por
vezes a automatização do processo é útil e importante. Por exemplo, fazer aparecer
ou criar uma shape quando a célula tem
um determinado valor.
Para mostrar como se pode, através
do VBA, automatizar processos utilizando shapes,
será criado um exemplo onde serão adicionadas/removidas dinamicamente numa folha
de cálculo de acordo com determinados critérios. Neste caso, existe uma lista de
produtos em que é feita uma comparação entre dois anos (2006 e 2007) e será colocada
um seta a indicar se existiu uma subida ou descida de vendas.
Para implementarmos este exemplo devemos
fazer o seguinte:
1 – Menu Tools – Macros – Visual Basic
Editor ou ALT+F11 na folha de calculo
2 – No
Editor, mais precisamente na janela de projecto, seleccionamos a nossa worksheet
(Sheet1 por exemplo)
3 – Colocamos o seguinte código no editor de código:
' Definição do tipo de seta
Enum ArrowType
UpArrow
DownArrow
End
Enum
' ------------------------------------------------------------------
' Criar uma nova shape na célula indicada
' ------------------------------------------------------------------
Private
Sub CreateShape(ByVal Cell
As Range, ByVal Arrow
As ArrowType)
Dim arrowWidth
As Double, arrowHeight
As Double
Dim arrowTop
As Double, arrowLeft
As Double
Dim sh As Shape
' Definições do tamanho
e localização da seta de modo
' a ficar centrada na
célula e com um comprimento
' comprimento de - 20%
(para não ocupar na totalidade)
arrowWidth = 15
arrowHeight = Cell.Height - (Cell.Height * 0.2)
arrowTop = Cell.Top + ((Cell.Height * 0.2) /
2)
arrowLeft = (Cell.Left + (Cell.Width / 2)) -
(arrowWidth / 2)
' Verifica qual o tipo
de célula pretendido
If Arrow = UpArrow
Then
' Adiciona
a shape na posição calculada
sh = ActiveSheet.Shapes.AddShape(msoShapeUpArrow,
arrowLeft, _
arrowTop, arrowWidth, arrowHeight)
' Define
a cor do interior e linha(verde)
With
sh
.Fill.ForeColor.RGB
= vbGreen
.Line.ForeColor.RGB
= vbGreen
End
With
Else
' Adiciona
a shape na posição calculada
sh = ActiveSheet.Shapes.AddShape(msoShapeDownArrow,
arrowLeft, _
arrowTop,
arrowWidth, arrowHeight)
' Define
a cor do interior e linha(vermelho)
With
sh
.Fill.ForeColor.RGB
= vbRed
.Line.ForeColor.RGB
= vbRed
End
With
End
If
End
Sub
' ------------------------------------------------------------------
' Apaga a shape na célula indicada
' ------------------------------------------------------------------
Private
Sub DeleteShape(ByVal Cell
As Range)
Dim sh As Shape
' Faz um ciclo em todas
as shapes na folha
For
Each sh In ActiveSheet.Shapes
' Caso a
sua localização esteja na indicada, apaga-a
If
Not (Intersect(sh.TopLeftCell, Cell)
Is Nothing) Then
sh.Delete()
End
If
Next
End
Sub
4 – Finalmente
no evento Worksheet Change colocamos o seguinte código que irá verificar qual o
valor alterado e indicará que tipo de shape
criar:
Private
Sub Worksheet_Change(ByVal Target
As Range)
' Verifica se existe uma
alteração no range B2:C10
If
Not Intersect(Target, [B2:C10]) Is Nothing Then
Dim
val1 As Integer
Dim
val2 As Integer
' Verifica os valores referentes ao ano (2006/207)
val1 = Cells(Target.Row, 2).Value
val2 = Cells(Target.Row, 3).Value
' Caso o
valor de 2006 seja superior
If
val1 > val2 Then
' Apaga a shape (caso exista) e cria uma nova
Call DeleteShape(Cells(Target.Row, 4))
Call CreateShape(Cells(Target.Row, 4), DownArrow)
'
Caso o valor de 2006 seja inferior
ElseIf
val1 < val2 Then
' Apaga a shape (caso exista) e cria uma nova
Call DeleteShape(Cells(Target.Row, 4))
Call CreateShape(Cells(Target.Row, 4), UpArrow)
'
Caso o valor seja igual, apaga a shape
Else
Call DeleteShape(Cells(Target.Row, 4))
End
If
End
If
End
Sub
Este exemplo poderia ser conseguido
muito mais facilmente, utilizando apenas uma formula, recorrendo a um determinada
fonte, como é o caso do Wingdings, e à formatação condicional. No entanto este exemplo pretende, acima de tudo,
mostrar como manipular shapes dinamicamente
e como este processo pode ajudar na automatização da nossa folha de cálculo.
PS: Como sempre, qualquer
dúvida, comentário ou correcção ao artigo é sempre bem vinda!
