Um dos factores que determinou o grande
sucesso do Microsoft Excel, para além da sua grande capacidade como folha de cálculo,
foi sem dúvida a grande diversidade de representação gráfica. Os gráficos permitem
mostrar de uma forma simples e visualmente muito agradável os resultados obtidos.
Existem dezenas de gráficos, com diferentes tipos e formatos que permitem agradar
a todos, exigindo apenas algum trabalho e bom gosto.
Mas no entanto, existem sempre coisas
que se necessita personalizar, quer seja os formatos, os textos, as cores, etc.
Muitas vezes é necessário (ou importante) alterar o gráfico de acordo com os resultados
e se automatizarmos esta personalização de acordo com um determinado critério, além
de simplificar o trabalho, evita também erros indesejados.
Uma das representações em gráfico
muito utilizadas é a definição de um valor e o objectivo a atingir. O seguinte exemplo
mostra como alterar a cor das barras de um gráfico de acordo com um objectivo. Neste
exemplo as barras ficam a verdes caso o resultado seja igual ou superior a um objectivo
definido (objectivo cumprido) e a vermelho caso estejam abaixo do objectivo.
Os gráficos funcionam com séries,
e um gráfico pode ter várias séries com diferentes tipos (barras, linhas, etc).
Cada série tem um conjunto de pontos que correspondem aos valores que são representados.

(figura 1)
Para implementarmos este exemplo é
apenas necessário criar uma tabela com alguns valores para o resultado (vendas)
e definir um objectivo (figura 1).
Depois abrir o Editor de Visual Basic (Tools – Macros – Visual Basic Editor ou ALT+F11) e definir para a Sheet1 o seguinte código:
' Código para a "Sheet1"
que executa caso algum valor seja alterado
Private Sub Worksheet_Change(ByVal
Target As Range)
' Caso seja alterado
algum valor na área B20:H21
If Not
Intersect(Target, [B20:H21]) Is Nothing Then
Application.ScreenUpdating = False
' Definição de variáveis
Dim ws As Worksheet
Dim
wsChartObject As ChartObject
Dim
wsCell As Range
' Atribuição de objectos às variáveis indicando qual é a worksheet
e
' qual é o nome do gráfico (visível na folha de cálculo)
Set ws = Worksheets("Sheet1")
Set
wsChartObject = ws.ChartObjects("Chart 1")
' Inicia um ciclo em todas as células da primeira linha (resultados
de vendas)
For Each wsCell In
ws.[B20:H20].Cells
' Selecciona a série 1 no ponto de acordo com
a coluna da célula actual
' pode-se alterar a coluna (column) para linha
(row) caso os dados estejam
' na posição vertical.
With wsChartObject.Chart.SeriesCollection(1).Points(wsCell.Column - 1).Interior
' Caso o valor da célula actual
seja igual ou superior à célula que está
' na linha abaixo da actual, coloca
diferentes cores. O valor desta célula
' na linha abaixo (objectivo) é
adquirida com a implementando a função
' OffSet que permite indicar uma
posição a partir da posição actual
If wsCell >=
wsCell.Offset(1) Then
.ColorIndex = 10 ' Verde
Else
.ColorIndex = 3
' Vermelho
End If
End With
Next
' Limpa as variáveis da memória
Set
ws = Nothing
Set
wsChartObject = Nothing
Application.ScreenUpdating
= True
End If
End Sub
O resultado final
(figura 2) pode ser visto alterando qualquer valor no Range definido no evento
Worksheet Change (que no exemplo é B20:H20)

(figura 2)
Este exemplo pretende mostrar como
modificar dinamicamente as cores de um gráfico com base num determinado critério,
mostrando de uma forma geral que é possível utilizar o VBA para efectuar modificações
nos gráficos de uma forma relativamente simples.
PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!
1 comentários:
Boa tarde,
Para fazer um gráfico dinâmico interativo, basta criar um evento PivotTableUpdate(ByVal Target As PivotTable) conforme abaixo:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
ActiveSheet.ChartObjects("Gráfico 2").Activate
ActiveChart.SeriesCollection(1).DataLabels.Select
Dim I As Integer
Dim it As Variant
Dim min, max, valor As Double
Dim a, b, c As Double
min = Application.WorksheetFunction.min(Range("B4:" & Range("B4").End(xlDown).Offset(-1, 0).Address))
max = Application.WorksheetFunction.max(Range("B4:" & Range("B4").End(xlDown).Offset(-1, 0).Address))
a = max * 0.25
b = max * 0.5
c = max * 0.75
For I = 1 To 20
On Error GoTo fim
Set it = ActiveChart.SeriesCollection(1).Points(I)
If CDbl(it.DataLabel.Text) < a Then
it.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
ElseIf CDbl(it.DataLabel.Text) >= a And CDbl(it.DataLabel.Text) < b Then
it.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
ElseIf CDbl(it.DataLabel.Text) >= b And CDbl(it.DataLabel.Text) < c Then
it.Format.Fill.ForeColor.RGB = RGB(0, 51, 204)
ElseIf CDbl(it.DataLabel.Text) >= c Then
it.Format.Fill.ForeColor.RGB = RGB(0, 51, 0)
End If
Next
fim:
end sub
Enviar um comentário