Visual Basic em Português

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!