Formato condicional de gráficos circulares (Pie Charts) en Excel

El tema del Formato Condicional en gráficos Excel es una de las consultas más usuales que llegan a este blog.
Un lector me consultaba como formar dinámicamente un gráfico circular, de manera que cada sección recibiera un color distinto de acuerdo a la magnitud del valor. Por ejemplo, si el valor es menor de 100, que reciba el color rojo, si está entre 100 y 300 el verde y si está por encima de 300 el azul.
Ya hemos visto como podemos dar formato condicional a un gráfico de columnas agrupadas sin usar macros.
Cuando se trata de gráficos circulares (pie charts) ya no tenemos más que apelar a las macros. Esto se debe a que estos gráficos están compuestos de una sola serie de datos. Cuando aplicamos formato a una serie, formamos todos los puntos de la serie. Si queremos formar cada punto con una trama o color distinto, tendremos que seleccionar cada punto por separado.
Empezamos por plantear nuestro ejemplo




En este caso hemos establecido la siguiente regla: si el valor es menor de 250 la sección tendrá el color rojo; entre 250 y 500 el color azul; entre 500 y 750 el color amarillo y por encima de 750 el color violeta.
La macro para lograr esto es




Sub cond_pie1()
Dim dtValorPto, serPtos As Long, iX As Long

If ActiveChart Is Nothing Then
MsgBox "Debe seleccionar un gráfico antes de accionar la macro", vbExclamation
Else
With ActiveChart.SeriesCollection(1)
serPtos = .Points.Count
dtValorPto = .Values

For iX = 1 To serPtos
Select Case dtValorPto(iX)
Case Is < 250
.Points(iX).Interior.ColorIndex = 3
     Case Is < 500
      .Points(iX).Interior.ColorIndex = 5
Case Is < 250
      .Points(iX).Interior.ColorIndex = 6
     Case Else
Points(iX).Interior.ColorIndex = 7
End Select
Next iX
End With
End If

End Sub




Lo que hace esta macro es evaluar el valor de cada punto y con Select Case asignarle un color.
En la hoja Colores del cuaderno del ejemplo, verán una tabla con los colores de la paleta (de mi máquina) y sus respectivos números de orden. Para extraer los números he empleado un UDF (función escrita por el usuario) muy sencilla


Function num_color(colCelda As Range)
num_color = colCelda.Interior.ColorIndex
End Function


En mi blog sobre Excel hay más sobre funciones para calcular y contar de acuerdo a colores.

Volviendo a nuestro ejemplo, podemos ver que tiene una gran desventaja. La escala de valores que determina los colores está determinada en el código de la macro (hard-coded) y no puede ser cambiada por el usuario.
Para darle más flexibilidad a nuestro modelo agregamos una tabla de valores en la hoja que contiene la tabla



El rango A8:A11 contiene los valores y los colores de cada intervalo. De 0 a 250, el color será rojo; de 250 a 750, azul; de 750 a 1000, amarillo y de 1000 en adelante, violeta.

Modificamos nuestro código para que reconozca el color que debe poner a canda punto basándose en su valor. Para esto usamos la función COINCIDIR en la macro (con su nombre inglés MATCH)


Sub cond_pie1a()
Dim dtValorPto, serPtos As Long, iX As Long
Dim rngColores As Range, colorCelda


Set rngColores = ActiveSheet.Range("A8:A11")

If ActiveChart Is Nothing Then
MsgBox "Debe seleccionar un gráfico antes de accionar la macro", vbExclamation
Else
With ActiveChart.SeriesCollection(1)
serPtos = .Points.Count
dtValorPto = .Values

For iX = 1 To serPtos
colorCelda = rngColores.Cells(WorksheetFunction. _
Match(dtValorPto(iX), rngColores, 1), 1).Interior.ColorIndex
.Points(iX).Interior.ColorIndex = colorCelda

Next iX
End With
End If

End Sub


Hasta ahora hemos condicionado el color del punto en la serie de acuerdo a su valor absoluto.
Si queremos condicionarlo de acuerdo a su valor relativo, tenemos que cambiar un poco las variables en nuestro código.
La variable dtValorPro(iX) contiene siempre el valor absoluto del punto. Por lo tanto, calculamos primero el total de todos los puntos y luego dividir el valor de cada punto por el total, para obtener el valor relativo. Todo es lo hacemos con esta rutina


Sub cond_pie2()
Dim dtValorPto, serPtos As Long, iX As Long
Dim dtValorTot
Dim rngColores As Range, colorCelda


Set rngColores = ActiveSheet.Range("A8:A11")

If ActiveChart Is Nothing Then
MsgBox "Debe seleccionar un gráfico antes de accionar la macro", vbExclamation
Else
With ActiveChart.SeriesCollection(1)
serPtos = .Points.Count
dtValorPto = .Values

For iX = 1 To serPtos
dtValorTot = dtValorTot + dtValorPto(iX)
Next iX

For iX = 1 To serPtos
colorCelda = rngColores.Cells(WorksheetFunction. _
Match(dtValorPto(iX) / dtValorTot, rngColores, 1), 1) _
.Interior.ColorIndex
.Points(iX).Interior.ColorIndex = colorCelda
Next iX
End With
End If

End Sub


En este caso también hemos agregado una tabla auxiliar con los valores y los colores en la hoja



El único problema que nos queda por resolver es que, si bien los valores del gráfico se actualizan al cambiar los valores de la tabla, no sucede lo mismo con el formato de los puntos del gráfico.
Para lograr que el gráfico se adapte los formatos a los cambios en la tabla programamos el evento Change de la hoja con esta macro


Private Sub Worksheet_Change(ByVal Target As Range)
Dim valRange As Range

Set valRange = Range("B2:B5")

If Union(Target, valRange).Address = valRange.Address Then
ActiveSheet.ChartObjects(1).Select
Call cond_pie1
End If

End Sub


Esta macro reconoce cuando ha sucedido un cambio en el rango de la tabla de valores del gráfico (B2:B5) y reacciona disparando la macro correspondiente.