RGB Farben an Pivot Chart übergeben
20.02.2021 10:45:35
Aparilo
nach tagelangem rumprobieren und suchen in Forumsbeiträgen in denen ich leider nichts passendes finden konnte, oder mein KnowHow einfach nicht ausreicht, hoffe ich das Ihr mir bei der Lösung des Problems helfen könnt.
Zu meiner Entschuldigung möchte ich noch kurz erwähnen das ich hier absoluter Neuling bin, leider bin ich schon am Upload der Beispiel Datei gescheitert (Verbindung wurde abgelehnt), woran könnte das liegen?
Ich habe eine Tabelle "Listenfelder" in der folgende kleine Tabelle steht, die Tabelle wird immer wieder um Einträge erweitert:
Spalte "AN" Spalte "AM"
BezeicnungFarben FarbenRGB
Restmüll und gewerblicher Abfall RGB(151, 182, 232)
Heizöl leicht RGB(193, 181, 162)
Strommix RGB(0, 94, 168)
Erdgas RGB(241, 180, 0)
Dieselkraftstoff RGB(0, 100, 113)
Fernwärme/kälte RGB(168, 17, 46)
Propangas RGB(255, 204, 153)
Benzin RGB(0, 125, 142)
Acetylengas RGB(255, 215, 87)
Flüssiggas (LPG) RGB(255, 153, 102)
Die Bezeichnungen in Spalte "AN" und der RGB - Wert in Spalte AM sollen als feste Farben an ein bzw. mehrere Pivot-Chart(s) übergeben werden, damit man die Farben nicht immer wieder manuell ändern muss. Ich habe versucht das so gut wie möglich im jetzigen Code zu beschreiben.
Leider scheitere ich trotz testen mehrerer Formatierungen und Variablen immer an der Übergabe der Werte (Typenunverträglichkeit - Laufzeitfehler 13).
Option Explicit
'*********************************************************************************
'*********************************************************************************
'Zuweisen der Farben aus der Tabelle Listenfelder - Spalte AN
'Durchlauf aller Diagramme und Datenpunkte
'Kreis aus Kreis Diagramm
'*********************************************************************************
Sub Diagramm_Farbe_zuweisen()
'Variablendeklaration
Dim i As Long 'Zähler für _
Schleife
Dim Farbe As Long 'Anstelle von _
ColorIndex
Dim chrDia As ChartObject 'Diagramm
Dim serReihe As Series 'Datenpunkte
'Tabelle aktivieren
Sheets("Scopes_Sum").Select
For Each chrDia In ActiveSheet.ChartObjects
Select Case chrDia.Chart.ChartType
Case xlPieOfPie 'Kreis aus _
Kreis Diagramm
' Schleife über alle Datenpunkte
With chrDia.Chart.SeriesCollection(1)
For i = 1 To .Points.Count
Select Case WorksheetFunction.Index(.XValues, i)
'der Durchlauf durch die Pivot-Diagramme (können mehrere sein klappt, aber das manuelle _
Eintragen von zusätlichen Werten
'ist leider sehr unkomfortabel.
'kann man hier eine Schleife einbauen, die anstelle des Strings, den Wert aus der Tabelle " _
Listenfelder" Spalte AM übernimmmt,
'und bei Farbe den entsprechenden RGB - Wert aus der Spalte AN ausliest oder übernimmt.
'Die Tabelle kann unterschiedlich viele Einträge enthalten, also es können weitere hinzukommen.
'Leider scheitere ich hier an der Übergabe Laufzeitfehler 13, egal welche Art von Deklaration _
ich wähle.
Case "Restmüll und gewerblicher Abfall"
Farbe = RGB(151, 182, 232) ' Hellblau
Case "Erdgas"
Farbe = RGB(241, 180, 0) ' Gelb
Case "Dieselkraftstoff"
Farbe = RGB(0, 100, 113) ' Dunkelgrün
Case "Heizöl leicht"
Farbe = RGB(193, 181, 162) ' Hellgrau
Case "Benzin"
Farbe = RGB(0, 125, 142) ' Hellgrün
Case "Flüssiggas (LPG)"
Farbe = RGB(255, 153, 102) ' Rosa
Case "Propangas"
Farbe = RGB(255, 204, 153) ' Rosa
Case "Acetylengas"
Farbe = RGB(255, 215, 87) ' Gelb - _
Abstufung
Case "Fernwärme/kälte"
Farbe = RGB(168, 17, 46) 'Rot
Case "Strommix"
Farbe = RGB(0, 94, 168) 'Blau
End Select
.Points(i).Interior.Color = Farbe
Next
End With
End Select
Next chrDia
End Sub