using VBA for a pie bubble chart in excel

Question

My code is

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
        Case 0
            GetColorScheme = thmColor1
        Case 1
            GetColorScheme = thmColor2
    End Select
End Function

the code is meant to change the colour theme of successive pie charts which are used as bubbles in a bubble chart. So The function is just meant to select a colour scheme which I previously saved as a string and then to change it according to the run of the script so that the first pie has another colour than the next pie chart .... I do get an error message when debugging the code at the line

ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)

the error message is runtime error 2147024809 saying the indicated value is out of range..can anybody help me what appears to be the problem here?

And would there be any way to integrate the display of the pie components (the name of the componetns which si indicated in the head of the column in each pie chart which is then transferred to the bubble chart?

Answer 1

The simplest route will be to just change the theme colors before you copy each chart.

Recorded macro will give you something like this (for Excel 2010 on Windows 7), I choose just two, but you could use any number of them, or you could create your own custom themes to use, too:

ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
    "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Apex.xml" _
    )
ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
    "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Essential.xml" _
    )

To replicate these, turn on your macro recorder, and then select a few color schemes from the Ribbon (Page Layout | Colors). I think this should work for Excel 2007+, although the file path will be different for 2007 than it is in my example.

Now, how to apply this to your code... THere are several ways to do this. I will add several Const string variables, storing the path of each them we will use. Then I will add an index variable and a function which will determine what theme to use based on the index.

You will need to add additional Case stements in the function to accommodate more than just two color themes, otherwise it will error.

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) '## Call a function to get the color scheme location
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
    thmColor = thmColor + 1  '## Increment our index variable
Next

lngPointIndex = 0

Application.ScreenUpdating = True
End Sub

Include an additional function, GetColorScheme. In this function, add Const string variables like thmColor1 and thmColor2, and assign their values to the file paths which you generate from the macro recorder when selecting a Color Theme. In this example, I only use two, but you could use many of them, as long as you add a corresponding Case in the Select block.

Function GetColorScheme(i as Long) as String  '## Returns the path of a color scheme to load
    '## Currently set up to ROTATE between only two color schemes.
    '   You can add more, but you will also need to change the 
    '   Select Case i Mod 2, to i Mod n; where n = the number 
    '   of schemes you will rotate through.
    Const thmColor1 as String = "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Apex.xml"
    Const thmColor2 as String = "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Essential.xml"


    Select Case i Mod 2  '## i Mod n; where n = the number of Color Schemes.
        case 0
            GetColorScheme = thmColor1
        case 1
            GetColorScheme = thmColor2
        'Case n  '## You should have an additional case for each 1 to n.
        '
    End Select
End Function