Tutorial I Grafici di Excel e il codice VBA – Parte 6 - Colori avanzati

Marius44

VBA Expert
Moderatore
Expert
9 Settembre 2015
6.607
115
76
Catania
Excel2010
238
Buongiorno

Completamento dei tutorial precedenti (I Grafici di Excel e il Codice VBA)

Ho diviso la problematica di due parti:
I Grafici di Excel e il codice VBA – Parte 5 - Colori di base
I Grafici di Excel e il codice VBA – Parte 6 - Colori avanzati
Alla fine di ciascuna sezione è allegato un file con esempi.

I Grafici di Excel e il codice VBA – Parte 6 - Colori avanzati
In questa sezione sono presentati alcuni lavori particolari, senza la pretesa di essere esaustivo, per manipolare i colori di un Grafico incorporato.
Qui viene proposto il codice VBA relativo a:
Colori condizionati dal colore di una cella – Colorare i diversi Punti di una Serie di un Grafico basandoci sul colore di una determinata cella ovvero sul colore riveniente da Formattazione Condizionale di una determinata cella.
Colori basati su carattere o valore di una cella – Colorare i diversi Punti di una Serie di un Grafico basandoci sul carattere oppure sul colore di una determinata cella
Colorare area entro due livelli - Colorare una area di un Grafico delimitata
Colore dinamico di un Istogramma – Colorare le colonne di un Istogramma in maniera dinamica basandoci su valori inseriti in due celle.

Si ribadiscono due necessarie premesse.
1 - Quasi sempre i Grafici vogliono la definizione del colore con RGB (Red, Green, Blu). Talvolta accettano anche altre definizioni (ColorIndex piuttosto che Color). Aiutatevi con i suggerimenti dell’intellisense: se dopo il punto trovate Color in genere occorre RGB.
Pertanto c’è di che sbizzarrirsi con oltre 16milioni di colori. Aggiungo che è possibile utilizzare anche i colori sfumati ma non li tratterò in questo tutorial; è materia d’approfondimento.
2 - La manipolazione di un Grafico incorporato può avvenire solo se lo stesso è attivato. Pertanto negli esempi seguenti troverete sempre, come prima, questa riga di codice:
ActiveSheet.ChartObjects(1).Activate
e suggerisco (ma non è obbligatorio) di inserire prima di End Sub la selezione di una cella del Foglio per evitare che il Grafico resti attivo. Negli esempi allegati trovate sempre la selezione di una cella.

Colore condizionato
In questo caso si vuole colorare un Grafico (talvolta userò questo termine per indicare una Serie oppure un Punto ma la cosa non genera confusione) a seconda dei colori presenti in una cella piuttosto che a dei colori da rendere uguali ad altri ovvero ancora colori rivenienti da una Formattazione condizionale. Vediamo di presentare la soluzione per i suddetti casi.

Colore uguale a colore cella
Abbiamo una serie di valori che rappresentano, ad esempio, il fatturato di una multinazionale suddiviso per continente. Abbiamo colorato le celle riferentesi al continente in un determinato colore. Vogliamo rappresentare il tutto con un Istogramma i cui valori per continente riportino il colore delle rispettiva cella. Se usassimo la normale tecnica, trattandosi di un’unica Serie, avremmo colonne dell’istogramma tutte dello stesso colore. Col codice seguente possiamo assegnare ad ogni punto della serie il colore della cella.
Visual Basic:
Sub Cells_Colors()
Dim vAddress As Range, i As Long
ActiveSheet.ChartObjects(1).Activate
With ActiveChart.SeriesCollection(1)
  Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
  For i = 1 To vAddress.Cells.Count
    .Points(i).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(vAddress.Cells(i).Interior.ColorIndex)
  Next i
End With
Cells(1, 1).Select
End Sub
Cosa abbiamo fatto? Abbiamo “splittato” (cioè separato) la formula della Serie assegnando l’indirizzo delle celle ad un oggetto Range. Quindi, ciclando da 1 al numero di celle interessate abbiamo assegnato ad un determinato punto il colore della cella corrispondente. Il risultato è che ogni continente ha il suo colore.
Di seguito riporto due modi per ripristinare il colore unico per la Serie. Lascio a voi capire le differenze (nel file d’esempio ho assegnato il secondo codice al pulsante).
Visual Basic:
Sub No_Colors()
Dim vAddress As Range, i As Long
ActiveSheet.ChartObjects(1).Activate
With ActiveChart.SeriesCollection(1)
  Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
  For i = 1 To vAddress.Cells.Count
    .Points(i).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
  Next i
End With
Cells(1, 1).Select
End Sub
Visual Basic:
Sub No_Colors_2()
Dim i As Long
ActiveSheet.ChartObjects(1).Activate
With ActiveChart.SeriesCollection(1)
  For i = 1 To .Points.Count
    .Points(i).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
  Next i
End With
Cells(1, 1).Select
End Sub
Colore basato su colori condizionati di celle
Supponiamo che stiamo eseguendo dei lavori; abbiamo approntato una tabella che riporta l’elenco completo (N° lavoro e importo) e, in altra colonna, la percentuale di “eseguito”. La detta percentuale è stata ottenuta con la Formattazione Condizionale stabilendo una sfumatura di tre colori base.
Per poter rappresentare questi ultimi colori non si può usare la tecnica precedente in quanto detti colori non verrebbero recuperati dalla formula della serie.
In questo caso è necessario utilizzare la proprietà .DisplayFormat.Interior dell’oggetto Range come da seguente codice:
Visual Basic:
Sub ColorsByFC()
Dim vAddress As Range, i As Long
ActiveSheet.ChartObjects(1).Activate
With ActiveChart.SeriesCollection(1)
  Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
  For i = 1 To vAddress.Cells.Count
    .Points(i).Format.Fill.ForeColor.RGB = Cells(i + 4, 4).DisplayFormat.Interior.Color
  Next i
End With
End Sub
Voglio attirare la vostra attenzione su un punto. Nella riga di codice compresa nel ciclo, cioè questa:

.Points(i).Format.Fill.ForeColor.RGB = Cells(i + 4, 4).DisplayFormat.Interior.Color

il Punto della Serie viene colorato in base al colore della cella di riga i + 4. Perché quel più 4? Non bisogna dimenticare che abbiamo “splittato” la formula della Serie per ottenere l’indirizzo delle celle interessate. Le “celle interessate” sono quelle che spazzoliamo col ciclo iniziando dalla prima fino all’ultima che si riferisce all’ultimo Punto. Però le celle a cui facciamo riferimento (cioè le celle che subiscono il colore condizionato) non iniziano dalla riga 1 ma qualche riga più sotto. Quante righe? E’ esattamente quel +4 (in questo caso)..
L’altro pulsante (non riporto il codice perché lo abbiamo visto in precedenza) serve per colorare gli spicchi secondo il colore delle celle in colonna B

Colori basati su carattere o valore di una cella
Anche questa sezione tratta di colore condizionato ma la “condizione” non è basata sul colore di una cella (diretto o condizionato) ma su un carattere oppure sul valore mostrato nella cella.

Colore basato sul carattere presente in una cella – Si suppone che, oltre ai valori che costituiscono la base per il Grafico, vi sia una colonna nella quale abbiamo inserito uno o più caratteri differenti. A seconda del carattere inserito i Punti della nostra Serie assumeranno un colore o un altro. Questo il codice:
Visual Basic:
Sub ColoreDaLettera()
Dim ur As Long, i As Integer, colore As Long
  ActiveSheet.ChartObjects(1).Activate
  For i = 1 To ActiveChart.SeriesCollection(1).Points.Count
    If Cells(i + 3, 2) Like "[Rr]" Then colore = vbRed
    If Cells(i + 3, 2) Like "[Bb]" Then colore = vbBlue
    ActiveChart.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = colore
  Next
Cells(7, 10).Select
End Sub
Questo, invece, il codice per riportare ad un colore unico la Serie:
Visual Basic:
Sub ColoreUnico()
  ActiveSheet.ChartObjects(1).Activate
  ActiveChart.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
  Cells(7, 10).Select
End Sub
Colore basato sul valore presente in una cella – Si vuol dare un colore diverso ai Punti di una Serie di un Grafico a seconda che il valore sia positivo o negativo. Questo il codice:
Visual Basic:
Sub ColorePos_Neg()
Dim i As Integer, colore As Long
  ActiveSheet.ChartObjects(2).Activate
  For i = 1 To ActiveChart.SeriesCollection(1).Points.Count
    ActiveChart.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
    ActiveChart.SeriesCollection(1).InvertIfNegative = True
    ActiveChart.SeriesCollection(1).InvertColor = RGB(255, 0, 0)
  Next
Cells(18, 10).Select
End Sub
Questo il codice per riportare ad un colore unico la Serie
Visual Basic:
Sub ColorePos_Neg_Unico()
  ActiveSheet.ChartObjects(2).Activate
  ActiveChart.SeriesCollection(1).InvertIfNegative = False
  ActiveChart.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
  Cells(18, 10).Select
End Sub
Colorare area entro due livelli
In verità non si colora un determinata area di un Grafico ma si sovrappone una Forma che assume i contorni stabiliti e che viene colorata. Vedremo appresso, infatti, che quando vogliamo “eliminare il colore” dal Grafico in effetti distruggiamo la Forma che avevamo creato.
Premetto che è il più complesso degli esempi proposti in quanto necessita di alcune formule particolari per l’individuazione dei vertici della Forma (Shape) e perché fa riferimento ai Nodi di detta Forma. Ma alla fine non è affatto difficile. E, dunque, vediamo questo Grafico.
Nel file d’esempio potete vedere che le colonne A e B riportano alcuni valori che, dati come origine ad un Grafico a dispersione con Linee smussate, mostrano una curva a “campana” (cosiddetta curva di Gauss). Nell’intervallo D4:H6 del Foglio potete vedere che vi sono altri dati: le celle riquadrate sono quelle nelle quali ho inserito due valori. In automatico le celle a fianco (sotto e a destra) mostrano altri dati. I valori sotto le celle riquadrate sono la copia (segno di = e la cella sopra) mentre le formule (matriciali) nelle celle E5:E6 e H5:H6 mostrano i corrispondenti valori di X e Y per le Serie rosse presenti nel Grafico.
Dopo questa “tiritera” ecco il codice che ci consente di “colorare” l’area compresa fra le suddette linee rosse e i margini della curva di Gauss (non spaventatevi per la lunghezza del codice):
Visual Basic:
Sub ColoraArea()
Dim myCht As Chart
Dim mySrs1 As Series, mySrs2 As Series, mySrs3 As Series
Dim Npts As Integer, Ipts As Integer
Dim myBuilder As FreeformBuilder
Dim myShape As Shape
Dim Xnode As Double, Ynode As Double, Xmin As Double, Xmax As Double
Dim Ymin As Double, Ymax As Double, Xleft As Double, Ytop As Double
Dim Xwidth As Double, Yheight As Double
Dim mn As Double, mx As Double, mn1 As Double, mx1 As Double
Dim y1 As Double, y2 As Double, x As Double
Dim a, b, c, d
ActiveSheet.ChartObjects(1).Activate
Set myCht = ActiveChart
Xleft = myCht.PlotArea.InsideLeft
Xwidth = myCht.PlotArea.InsideWidth
Ytop = myCht.PlotArea.InsideTop
Yheight = myCht.PlotArea.InsideHeight
Xmin = myCht.Axes(1).MinimumScale
Xmax = myCht.Axes(1).MaximumScale
Ymin = myCht.Axes(2).MinimumScale
Ymax = myCht.Axes(2).MaximumScale
Set mySrs1 = myCht.SeriesCollection(1)
Set mySrs2 = myCht.SeriesCollection(2)
Set mySrs3 = myCht.SeriesCollection(3)
mn = Range("D5").Value
mx = Range("D6").Value
mn1 = Range("G5").Value
mx1 = Range("G6").Value
Npts = mySrs1.Points.Count
y1 = Ytop + (Ymax - mySrs2.Values(1)) * Yheight / (Ymax - Ymin)
y2 = Ytop + (Ymax - mySrs3.Values(1)) * Yheight / (Ymax - Ymin)
a = mySrs2.XValues(1)
b = mySrs2.Values(1)
'primo punto
Xnode = Xleft + (mySrs2.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - mySrs2.Values(1)) * Yheight / (Ymax - Ymin)
Set myBuilder = myCht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
'restanti punti
For Ipts = 1 To Npts
  Xnode = Xleft + (mySrs1.XValues(Ipts) - Xmin) * Xwidth / (Xmax - Xmin)
  Ynode = Ytop + (Ymax - mySrs1.Values(Ipts)) * Yheight / (Ymax - Ymin)
  Select Case Ynode
  Case y1 To y2
    myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
  Case Is < y2
    If mySrs1.XValues(Ipts) <= 0 Then
      Xnode = Xleft + (mySrs3.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
      Ynode = Ytop + (Ymax - mySrs3.Values(1)) * Yheight / (Ymax - Ymin)
    Else
      Xnode = Xleft + (mySrs3.XValues(2) - Xmin) * Xwidth / (Xmax - Xmin)
      Ynode = Ytop + (Ymax - mySrs3.Values(2)) * Yheight / (Ymax - Ymin)
    End If
    myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
  Case Is > y1
    If mySrs1.XValues(Ipts) >= 0 Then
      Xnode = Xleft + (mySrs2.XValues(2) - Xmin) * Xwidth / (Xmax - Xmin)
      Ynode = Ytop + (Ymax - mySrs2.Values(2)) * Yheight / (Ymax - Ymin)
      myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
    End If
  End Select
Next
'Ultimi due punti
Xnode = Xleft + (mySrs2.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - mySrs2.Values(1)) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Set myShape = myBuilder.ConvertToShape
With myShape 'colora la figura - colori a scelta
  .Fill.ForeColor.SchemeColor = 11  'verde chiaro
  .Line.ForeColor.SchemeColor = 17  'verde scuro
  .Line.Weight = 1.5
  .Fill.Transparency = 0.9
End With
Cells(15, 11).Select
End Sub
Cerco di spiegare cosa fa il codice (come potete dedurre NON MIO). Dopo e dichiarazioni delle variabili o altro, assume le “misure” dell’Area di plottaggio del Grafico, il valore minimo e massimo dei due Assi, e le 3 Serie. Quindi procede assumendo i valori delle due Linee rosse.
Ora cominciano i “dolori”.
Infatti il codice calcola il primo punto per disegnare la Forma a mano libera (FreeForm) e lo fissa, quindi procede con un ciclo per segnare gli altri punti di contorno ed infine calcola gli ultimi due punti per chiudere la figura. Ottenuta la Forma (Shape) colora il suo interno in verde chiaro ed il bordo in verde scuro, aumentando un poco lo spessore della linea di bordatura.
Finito.
Come dicevo prima, per cancellare il colore ci avvaliamo della proprietà .Cut di Shapes per eliminare la forma che avevamo creato e colorato. Questo il codice:
Visual Basic:
Sub Elimina_Colore()
Dim x As Integer, i As Integer
ActiveSheet.ChartObjects(1).Activate
x = ActiveChart.Shapes.Count
For i = 1 To x
  If Left(ActiveChart.Shapes(i).Name, 4) = "Free" Then
    ActiveChart.Shapes(i).Cut
    Exit For
  End If
Next i
Cells(15, 11).Select
End Sub
Colore dinamico di un Istogramma
Supponiamo di aver rilevato il valore di un titolo ogni 5 minuti. Abbiamo rappresentato dette rilevazioni in Istogramma e vediamo che tutte le colonne hanno, e non poteva essere altrimenti, il medesimo colore trattandosi di una sola Serie. Però vogliamo mettere in evidenza le rilevazioni da una certa ora ad un’altra con un colore diverso. Come facciamo?
Semplice. Inseriamo in due celle l’orario iniziale e l’orario finale che vogliamo mettere in evidenza.
Poi inseriamo questo codice (ATTENZIONE – va inserito nel Modulo di classe del Foglio interessato):
Visual Basic:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2:E2")) Is Nothing Then
  Dim orario1 As Double, orario2 As Double
  Dim ur As Long, i As Long
  orario1 = Cells(2, 4).Value
  orario2 = Cells(2, 5).Value
  ur = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  ActiveSheet.ChartObjects(1).Activate
  With ActiveChart.SeriesCollection(1)
    For i = 3 To ur
      If Cells(i, 1) >= orario1 And Cells(i, 1) <= orario2 Then
        With .Points(i - 2).Format
          With .Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Solid
          End With
          With .Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
          End With
        End With
      Else
        With .Points(i - 2).Format
          With .Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 255)
            .Solid
          End With
          With .Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 255)
          End With
        End With
      End If
    Next i
  End With
  Cells(7, 3).Select
End If
End Sub

Ed ecco le colonne relative ai nostri orari in bella evidenza.



Bene! Mi fermo qui. Se siete arrivati fino a qui vi meritate un premio: “la Coccarda virtuale”. SmileFace
Tenete presente che vi sono moltissime varianti e complicazioni (non potevo e non volevo essere "una biblioteca).
Per chi volesse approfondire invito a fare una ricerca in rete. L’elenco sarà infinito.

Buon divertimento.
Ciao,

Mario
 

Allegati

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!