Verwendung von VBA zum Färben von Kreisdiagrammen

Ich habe den folgenden Code, in dem der Code versucht, ein Blasendiagramm mit Kreisdiagrammen als die Blasen zu erstellen. Da in dieser Version Farbthemen verwendet werden, um in jedem Kreisdiagramm (Blase) im Funktionsteil eine andere Farbe zu erstellen, habe ich das Problem, dass dies abhängig von den Pfaden zu den Farbpaletten funktioniert.

Gibt es eine einfache Möglichkeit, die Funktion so zu gestalten, dass sie unabhängig von diesen Pfaden funktioniert, indem entweder eine Farbe für jedes Kreisdiagrammsegment codiert wird oder standardisierte Pfade verwendet werden (wahrscheinlich nicht möglich, nicht wünschenswert).

    Sub PieMarkers()

Dim chtMarker As Chart
Dim chtMain As Chart
Dim intPoint As Integer
Dim rngRow As Range
Dim lngPointIndex As Long
Dim thmColor As Long
Dim myTheme As String


Application.ScreenUpdating = False
Set chtMarker = ActiveSheet.ChartObjects("chtMarker").Chart
Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart

Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart
Set rngRow = Range(ThisWorkbook.Names("PieChartValues").RefersTo)

For Each rngRow In Range("PieChartValues").Rows
    chtMarker.SeriesCollection(1).Values = rngRow
    ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
    thmColor = thmColor + 1
Next

lngPointIndex = 0

Application.ScreenUpdating = True
End Sub

Function GetColorScheme(i As Long) As String
Const thmColor1 As String = "C:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\Blue Green.xml"
Const thmColor2 As String = "C:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\Orange Red.xml"
    Select Case i Mod 2
        Case 0
            GetColorScheme = thmColor1
        Case 1
            GetColorScheme = thmColor2
    End Select
End Function

Der Code kopiert immer wieder ein einzelnes Diagramm auf die Blasen. Daher möchte ich die Funktion (jetzt Get colourscheme) in eine Funktion ändern, die jedem Segment jedes Kreisdiagramms eine eindeutige RGB-Farbe zuweist. Ein ähnliches Thema wird hier diskutiertÄndern Sie die Punktfarbe im Diagramm Excel VBA aber der Code funktionierte anscheinend nicht für die Person, die fragte. Könnte mir jemand einen Rat geben, wie man den Funktionsteil des Codes umschreibt

Mein grober Ansatz wäre:

Wählen Sie das Arbeitsblatt aus und greifen Sie nach dem Kopieren nach jedem DiagrammÄndern Sie die Farbe jedes Segments mit einem eindeutigen RGB-Code

Aber wie ich es in VBA umsetzen würde, ist mir nicht klar. Ich würde mich über Kommentare zu diesem Thema sehr freuen.

Antworten auf die Frage(2)

Ihre Antwort auf die Frage