La consultazione del forum è libera per tutti.
Per poter porre un quesito è invece necessario essere un utente registrato (clicca qui se non lo sei).
Tutti gli utenti che richiedono un supporto, come da REGOLAMENTO, sono caldamente invitati ad allegare un file di esempio con l'indicazione di quello che si desidera ottenere.
Buonasera, ho la necessità di creare un indicatore grafico come in allegato, i 5 settori esterni hanno la stessa dimensione, riportano le lettere nella tabella dati e dovrebbero cambiare il loro colore secondo la scala sopra alla tabella, al centro invece ci deve essere la media dei 5 valori. In futuro l'indicatore dovrà aumentare il numero di settori, mantenendo le caratteristiche descritte prima.
Grazie.
Ciao
Non hai impostato alcun Grafico (ma solo un'immagine). Se non ti sforzi a tentare non imparerai.
Ho spostato la disposizione dei dati. Ho inserito una Formattazione condizionale nelle celle D1:D23 (per le future esigenze) e nella cella F1. Ho inserito un Grafico a torta (oppure ad anello, se preferisci) e un cerchio al centro. A quest'ultimo ho collegato il valore con la cella F1
E' necessario il ricorso a VBA.
Questa la macro che colora i settori della serie e anche il cerchio al centro.
Sub ColoreSettoriComeColoreCelle()
With Sheets(1).ChartObjects(1).Chart.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).DisplayFormat.Interior.Color
Next i
End With
ActiveSheet.ChartObjects(1).Activate
ActiveChart.Shapes.Range(Array("Oval 1")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = Cells(1, 6).DisplayFormat.Interior.Color
.Transparency = 0
.Solid
End With
Cells(1, 1).Select
End Sub
Questo il codice da inserire nel Modulo del Foglio
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1:D23")) Is Nothing Then
Call ColoreSettoriComeColoreCelle
ActiveWorkbook.Save
End If
End Sub
Fai sapere. Ciao,
Mario
@marius44 grazie,
il grafico è come me lo aspettavo ma i settori esterni dovrebbero avere la stessa dimensione, inoltre se volessi inserire un grafico analogo in ogni foglio di calcolo, quali sono i parametri nel VBA da modificare? Dall’esempio presumo che in ogni foglio dovrei richiamare una macro dedicata, che a sua volta rimanda al modulo1 dove si troveranno tutte le macro, ma al loro interno quali parametri modifico? Grazie.
Ho notato adesso che il centro del grafico “Oval 1” non restituisce il colore secondo la formattazione condizionale.
Ciao
Ho notato qualche piccola discrepanza nel file (come t'ho detto, non è affatto semplice costruirlo).
Ti allego un nuovo file che risponde ad ogni cambiamento dell'intervallo A2:B28 - Vedi se si adatta meglio alle tue esigenze (guarda il codice nel Modulo del Foglio e attento ai valori della Formattazione condizionale, sia per i valori sia per la media).
Cosa intendi per "settori esterni"?
Quando dici che devi adattarlo ad altri Fogli dovrebbe essere sufficiente inserire la macro in ciascun Modulo dei diversi Fogli purchè i dati siano sempre nella medesima posizione e la FC sia adatta al foglio relativo.
Fai sapere. Ciao,
Mario
ora mi trovo meglio perchè il codice VBA è stato inserito in ogni foglio di calcolo, in allegato il file modificato con il foglio "settori uguali" nel quale dscrivo cosa intendo, si tratta di un dettaglio che non cambia l'ottimo risultato già raggiunto, poi c'è un altro foglio con un esercizio nel quale ho provato a spostare i dati, cambiando alcuni riferimenti nel codice VBA sono riuscito a far rispondere correttamente la media nel grafico, ma non il colore dei valori nei settori, tutte le etichette sono corrette, cosa ho sbagliato?
Grazie.
Ciao
Intanto son contento che sei riuscito a capire e duplicare l'esercizio. Bravo. Adesso veniamo alle tue richieste.
Nella parte di codice che assegna il colore ai vari punti della serie fai attenzione a quale cella si riferisce. Per esempio, nel Foglio1 il cui ciclo incomincia da 1 dico a VBA di colorare il punto i: con il colore (riveniente da FC) della cella i+1 della colonna 2, come puoi notare qui:
.Points(i).Format.Fill.ForeColor.RGB = Cells(i + 1, 2).DisplayFormat.Interior.Color
Devi procedere secondo questa logica se sposti i dati e la relativa FC in altre posizioni.
Settori uguali. La cosa si complica un pochino perchè sia il Grafico a torta sia quello ad anello creano i settori in base al valore intrinseco di ciascun settore rapportato al totale (100). Ora, se vuoi che i settori abbiano la stessa ampiezza, occorre creare un'altra colonna che divida il 100 di cui sopra per il numero di settori ed assegni questo valore come ampiezza del settore stesso. Quindi il colore e l'etichetta possono essere riferiti ai valori effettivi. Ti assicuro che non è impossibile ma senza dubbio non è di facilissima realizzazione.
Un'altra cosa mi ero scordato: il Grafico e la forma al centro devono essere raggruppati altrimenti quando cerchi di spostare il Grafico sposti solo questo ed il centro resta dove è.
Spero sia chiaro. Comunque se hai bisogno (io nei limiti del mio tempo libero) siamo qui.
Ciao,
Mario
PS - Non sono intervenuto sul tuo file (per i dati spostati) per "costringerti" a farlo tu e così impari. ? ?
Ciao
Ti allego il file con "i settori uguali"
In D2 (e copiata in basso) c'è questa formula
=SE(E(A2<>"";B2<>"");ARROTONDA(100/$E$2;0);NON.DISP())
Come noterai fa riferimento alla cella E2 in cui c'è questa formula =CONTA.NUMERI(B:B)
La formula mostra un valore identico per tutte le celle valorizzate e mette #N/D per quelle vuote.
Questa invece la macro da inserire nell'Evento Worksheet_Change del Foglio "settori uguali"
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:B26")) Is Nothing Then
If (Target.Column = 1 And Cells(Target.Row, 2) = "") Or _
(Target.Column = 2 And Cells(Target.Row, 1) = "") Then Exit Sub
'grafico valori
ActiveSheet.ChartObjects(1).Activate
With ActiveChart.SeriesCollection(1)
Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
For i = 1 To vAddress.Cells.Count
If Cells(i, 2) = "" Then Exit For
et = Cells(i + 1, 1) & " " & Cells(i + 1, 2) * 100 & "%"
.DataLabels.Select
.Points(i).DataLabel.Select
Selection.Formula = et
.Points(i).Format.Fill.ForeColor.RGB = Cells(i + 1, 2).DisplayFormat.Interior.Color
Next i
End With
'centro media
ActiveSheet.Shapes.Range(Array("Oval 3")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = Cells(2, 3).DisplayFormat.Interior.Color
.Transparency = 0
.Solid
End With
Cells(1, 1).Select
End If
End Sub
Non ho dichiarato le variabili (poi lo farai tu); ti dico solo che le etichette devono essere inserite tramite VBA perchè si riferiscono ad un'altra colonna (si potrebbe fare a manina ... una alla volta, ma mi sembra meglio così).
Per quanto attiene all'altro problema (dati spostati) aspetto tue nuove (spero positive).
buonasera, con le tue indicazioni sono riuscito a cambiare i parametri nel VBA per associarli allo spostamento dei dati nel foglio di calcolo, proseguirò con l'ultimo file allegato "Copia di Bersaglio_2" per riprodurre l'indicatore mantenedo uguali i settori del grafico. Grazie.
Buonasera @Marius44,
ho iniziato ad utilizzare la penultima versione del file di Copia di Bersaglio, non ho ancora provato l'ultima versione con i settori uguali, mi sono accorto che il bersaglio smette di cambiare colore secondo la FC se il dato nella cella viene riportato attraverso una formula, nel file in allegato è sicuramente più chiaro.
Grazie.
Ciao
L'Evento Worksheets_Change ha bisogno di un "cambiamento fisico" nell'intervallo considerato, per fisico intendo il cambiamento fatto "a manina" non riveniente da una formula.
Nel caso in esame puoi cambiare l'intervallo di riferimento con quello dove "inserisci" i dati, cioè:
If Not Intersect(Target, Range("K2:K26")) Is Nothing Then
Ciao,
Mario
Ciao Mario, sto provando in tutti i modi nell' inserire il grafico "bersaglio" nel foglio "ufficiale", creo la tabella con i dati con la FC esattamente nella stessa posizione del tuo foglio, creo il grafico ad anello (grafico 2) con l'ovale (ovale 3), copio e incollo il codice VBA nel foglio corrispondente, aggiorno in "If Not Intersect(Target, Range("g36:k36")) Is Nothing Then" per il cambiamento fisico, modifico ActiveSheet.Shapes.Range(Array("Oval 3")).Select, ma poi i colori nel grafico non rispondono a quelli della FC nelle celle...il grafico ha i colori default e non ne vuole sapere di adattarli a quelli nelle celle con la FC
Grazie.
Ciao
Non capisco!
Ma i dati non erano in verticale e solo su una colonna? Cosa vuol dire quest'intervallo Range("g36:k36")?
Prova a spiegare meglio e, al caso, allega il file originale (senza dati sensibili, ovviamente)
Ciao,
Mario
@marius44 ciao,
allego un file con due esempi, foglio 1 orizzontale per i dati disposti in orizzontale che verranno copiati nelle celle usate dal grafico e il foglio 1 verticale per i dati in verticale, in entrami gli esempi i dati finali usati per il grafico sono sempre in verticale come nel file "Copia di Bersaglio", il fatto è che il grafico risponde numericamente, ma non risponde con l'acquisizione della FC presente nelle celle B2:B6, stessa questione per l'ovale al centro del grafico con la FC nella cella "Cells(2, 3)" dove presumo che corrisponda alla C2.
Grazie.
Ciao
ti ho detto che l'Evento Worksheet_Change risponde ad un cambiamento "fisico".
Se non ho preso un abbaglio i Grafici (entrambi) risponderanno se la prima riga è corretta così
If Not Intersect(Target, Range("G15:K35")) Is Nothing Then
Fai sapere. Ciao,
Mario
