VBA Code: Apply Accent1-6 colors on charts in Excel workbook

[bcrafty]

Hi there,
I am still a novice to VBA (even after dipping in and out over the years), hence this question, and have recorded the below.
My requirements are to apply some/all of the Accent1-6 colour palette to the chart series.
Ideally I want the colours to be the real accent colours, so NOT as on LHS (even though the colours match), but as RHS in the below image.
I need the charts to automatically update to the specific colour palette in different files.
The process below (e.g. applying msoThemeColorAccent1 etc.) seems to work for cells, shapes and even chart background colours, but not Series Fills/Lines in charts.
Any advice gratefully received.
Thanks

Sub ChartSeriesColorKEEP()
'
' ChartSeriesColor Macro
'

'
ActiveChart.FullSeriesCollection(1).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveChart.FullSeriesCollection(2).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveChart.FullSeriesCollection(3).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent3
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveChart.FullSeriesCollection(4).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent4
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveChart.FullSeriesCollection(5).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent5
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveChart.FullSeriesCollection(6).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
End Sub

 

[coulombevin]

Hi bcrafty,

Sorry for the delay I didn't saw your request. Here's the corected code:

Sub ChartSeriesColorKEEP()
    Dim p As Integer, nbPoints As Integer
    Dim c As Integer, nbChart As Integer
    Dim s As Integer, nbSeries As Integer
    nbChart = ActiveSheet.ChartObjects.Count
    c = 1
    If nbChart > 0 Then
        For c = 1 To nbChart
            ActiveSheet.ChartObjects(c).Activate
            With ActiveChart
                s = 1
                nbSeries = .FullSeriesCollection.Count
                For s = 1 To nbSeries
                    With .FullSeriesCollection(s)
                        p = 1
                        nbPoints = .Points.Count
                        For p = 1 To nbPoints
                            With .Points(p).Format.Fill
                                .Visible = msoTrue
                                Select Case s
                                    Case 1
                                        .ForeColor.ObjectThemeColor = msoThemeColorAccent6
                                    Case 2
                                        .ForeColor.ObjectThemeColor = msoThemeColorAccent5
                                    Case 3
                                        .ForeColor.ObjectThemeColor = msoThemeColorAccent4
                                    Case 4
                                        .ForeColor.ObjectThemeColor = msoThemeColorAccent3
                                    Case 5
                                        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
                                    Case 6
                                        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
                                    Case Else
                                        MsgBox "You have more points than mso color!", vbOKOnly + vbCritical, "To many points"
                                        Exit Sub
                                End Select
                                .ForeColor.TintAndShade = 0
                                .ForeColor.Brightness = 0
                                .Transparency = 0
                                .Solid
                            End With
                        Next p
                    End With
                Next s
            End With
        Next c
    End If
End Sub

You'll have to change manually your sheet, but we could add a function to also loop sheet from your workbook.

Bests regards,

Vincent