-1

I have the following code

    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

The code tries to create a bubble chart with pie charts as the bubbles. As in this version colour themes are used to create a different colour in each pie chart (bulbble). However si there any way to do this without colour themes. I have been ointed to Collection object to do this but do not know how to implement this into the code. I suppose I woudl have to change the function part of the above code?

Updated code

    Sub PieMarkers()

Dim srs As Series
Dim pt As Point
Dim p As Long
Dim c As Long
Dim col As Long
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)

Set srs = chtMarker.SeriesCollection(1)
For Each rngRow In Range("PieChartValues").Rows
    c = c + 1
    srs.Values = rngRow
    For p = 1 To srs.Points.Count
        Set pt = srs.Points(p)
        With pt.Format.Fill.ForeColor
            col = p + (srs.Points.Count * c)
            If col = 1 Then .RGB = 113567
            If col = 2 Then .RGB = 116761
            If col = 3 Then .RGB = 239403
            If col = 4 Then .RGB = 398394
            'etc.
            'etc.
            '## Add more IF statements to assign more colors.
            If col = 24 Then .RGB = 1039834
        End With
    Next
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
Next
lngPointIndex = 0

Application.ScreenUpdating = True
End Sub

so i can compile the lower bit of code without an error the problem is that the chart is afterwards only coloured in two colours (not 5 as as specified in the code). There are 8 pie charts, each of which has three different segments. Each segment (24 in total) shoudl have a different colour which is indicatable by an RGB value as in the first answer

Undo
  • 25,519
  • 37
  • 106
  • 129
Timon Heinomann
  • 57
  • 1
  • 4
  • 10
  • possible duplicate of [How to use VBA to colour pie chart](http://stackoverflow.com/questions/17385213/how-to-use-vba-to-colour-pie-chart) – David Zemens Jun 30 '13 at 15:06

1 Answers1

1

As I understand it you have 3x8 = 24 colors that you need. I only put a few in here as examples (e.g., 113567, 1039834, etc) to show you what I mean.

There are more sophisticated ways of doing this, but at this point I think they are beyond your skill set, so we are going to do brute force, explicit operations.

You will need to:

  • Add the appropriate number of If/Then statements inside the With block.
  • Identify the several RGB/Long values to use for the colors inside these If/Then statements. I think you need 24.

I would declare a few more variables to tidy up the code:

Dim srs as Series
Dim pt as Point
Dim p as Long '# Point Counter
Dim c as Long '# Chart Counter
Dim col as Long '# p*c

Then modify your For Each rngRow... loop, like so:

Set srs = chtMarker.SeriesCollection(1)
For Each rngRow In Range("PieChartValues").Rows
    c = c+1
    srs.Values = rngRow
    '## The loop below will be used to do colors on individual points:
    For p = 1 to srs.Points.Count
        Set pt = srs.Points(p)
        With pt.Format.Fill.ForeColor
            col = p+(srs.Points.Count * c)
            If col = 1 then .RGB = 113567
            If col = 2 Then .RGB = 209345
            If col = 3 Then .RGB = 239403
            If col = 4 Then .RGB = 398394
            'etc.
            'etc.
            '## Add more IF statements to assign more colors.
            If col = 24 Then .RGB = 1039834
        End With
    Next
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
Next

We have a new variable col which will be a value between 1 and 24, that will be set for each point in each chart. Inside the With block, we assign a color to each point.

In the first chart, this should use col values of {1,2,3}, in the second chart it should use values of {4,5,6} and in the third chart, {7,8,9}, etc.

So it only applies one color to one point, but it assigns a different color to each of 3 points in each of 8 charts.

David Zemens
  • 53,033
  • 11
  • 81
  • 130
  • @TimonHeinomann correct. That function was used to dynamically load one of several color schemes. In this code, we don't need to do that, we simply assign color for each point in each chart. I made a revision that I think ensures that no color will be used more than once, as long as you put 24 different `If/Then` statements. – David Zemens Jun 30 '13 at 14:38
  • No, that's not how it works. But since I have not tested it, I need to make another revision. – David Zemens Jun 30 '13 at 14:48
  • Yes, that should be correct. I assumed 3 charts, 8 points. But if it is 8 charts, 3 points each, this code should work on that, too. – David Zemens Jun 30 '13 at 14:56
  • Also, if this is ultimately not working, you are going to have to figure it out on your own. I will not be answering this question anymore. – David Zemens Jun 30 '13 at 14:58
  • If you post the code that you are using, I can maybe help. Otherwise, I can't read your mind. – David Zemens Jun 30 '13 at 15:38
  • You did not follow my instructions to add additional `If/Then` statements for the other colors. Although I do not know what the result will be, it will obviously not assign the different colors. You need to add the statements for when `col = 5` thru `col = 23`... – David Zemens Jun 30 '13 at 15:48