Office: (Office 2016) Kreisdiagramm-Farben automatisch ändern

Hallo Community,

nachdem ich bisher als Besucher alle meine Probleme gelöst bekommen habe, mir zu diesem Thema aber den Ast abgesucht/versucht habe, muss ich nun doch selbst mal fragen...

Folgendes:

Ich habe eine Excel mit verschiedenen Sheets und Auswertungen.

- Auf Sheet 1 "Verkauf" habe ich Verkäufe von Obst und Gemüse mit Datum.
- Auf Sheet 2 "Berechnungen" habe ich eine tabellarische Auswertung der Anzahl der verkauften Produkte unterteilt nach Obst und Gemüse samt einer automatischen Sortierung.

Den Anhang Obst.xlsm betrachten

Nun möchte ich die Anzahl der verkauften Produkte in Kreisdiagrammen auf einem Sheet 3 "Jährlich" darstellen lassen und zwar für jedes Jahr und nach Obst oder Gemüse getrennt. Ein Kreisdiagramm für Obst 2017, eins für Gemüse 2017, eins für Obst 2018 usw... Dabei sollen aber die einzelnen Segmente der Diagramme immer die gleiche Farbe haben. Äpfel sind immer rot, Birnen grün, Bananen gelb usw.

Ich habe hier im Forum (und auch anderswo) ähnliche Themen, aber zu Balkendiagrammen gefunden. Dort ging es darum, die Zielzellfarbe zu übernehmen. Leider war es mir nicht möglich, diese auf Kreisdiagramme zu übernehmen (ich habe auf Sheet 2 "Berechnungen" den Zellen schon die Farben mit bedingter Formatierung zugewiesen).

Wie könnte ich das umsetzen (auch gerne VBA)?

Vielen Dank für eure Zeit und Hilfe.

Besten Gruß
Tom

 

Hi Tom,

du hast es noch besonders schwer gemacht, weil du keine direkte Zellfärbung sondern die bedingte Formatierung verwendest. Aber nichts desto trotz :D - folgendes Makro sollte dein Problem lösen:

Code:

Sub DiasFaerben()
    Dim chrDia As ChartObject
    Dim intPunkt As Integer
    Dim rngBereich As Range
    For Each chrDia In Worksheets("Jährlich").ChartObjects
        With chrDia.Chart
            Set rngBereich = Range(Split(.SeriesCollection(1).Formula, ",")(1))
            For intPunkt = 1 To .SeriesCollection(1).Points.Count
                With .SeriesCollection(1).Points(intPunkt).Format.Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = rngBereich.Cells(intPunkt).DisplayFormat.Interior.Color
                    .Transparency = 0
                    .Solid
                End With
            Next intPunkt
        End With
    Next chrDia
End Sub

Bis später,
Karin

 

Guten Morgen Karin,

vielen Dank! Nicht umsonst eine Legende. Deine Antworten haben mir schon öfters geholfen.

Ich muss ja die bedingte Formatierung nehmen, da sich die Reihenfolge ändern kann und die Farbe somit "mitgenommen" wird. :-)

Bei Gemüse 2019 wird noch ein Fehler angezeigt.


In meiner eigentlichen Excel passt aber alles.

Wie kann ich jetzt das Makro bei Änderung automatisch ablaufen lassen? Ich habe es so probiert:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, sheets("Verkauf")) Is Nothing Then Exit Sub
Call Obst_Gemüse.DiasFaerben
End Sub

Klappt aber leider nicht.

Vielen Dank und beste Grüße
Tom

 

Hi Tom,

das Makro steht in einem Standardmodul? Dann musst du nicht Call benutzen sondern kannst einfach schreiben

Code:

DiasFaerben

Ich würde das nicht mit dem Workseet_Change-Ereignis realisieren, weil das Makro dann bei jeder Eingabe ausgeführt würde, wodurch die Mapper verlangsamt wird. An deiner Stelle würde ich das Doppelklick-Eriegnis verwenden - dann kannst du das Makro zielgerichtet starten.

Bis später,
Karin

 

Hi Karin,

ja, du hast recht. Vor allem, da meine Excel mittlerweile sehr umfangreich ist.

Ich habe das jetzt über eine Schaltfläche realisiert.

Vielen Dank für deine Hilfe!

Beste Grüße
Tom