Excel Charts : Color XY Scatter Points. XY Scatter Coloration Plot

Option Explicit

Sub Main()

    Dim clsSpectrum As CSpectrum
    
    Set clsSpectrum = New CSpectrum
    With clsSpectrum
        .Count = 56                       ' number of colours in spectrum
        .Start Color = RGB(0, 0, 255) ' Blue 
        .EndColor = RGB(255, 0, 0)   ' Red
        .CreateSpectrum
    End With

    UsingMarkers clsSpectrum, ActiveSheet.ChartObjects(1).Chart
    UsingCustomMarkers clsSpectrum, ActiveSheet.ChartObjects(2).Chart
    
End Sub

Sub UsingMarkers(Spectrum As CSpectrum, Cht As Chart)
'
' Using builtin color palette
'
    Dim lngIndex As Long
    Dim intPoint As Integer
    
    With Cht
        With .SeriesCollection(1)
            For intPoint = 1 To .Points.Count
                lngIndex = intPoint * (Spectrum.Count / .Points.Count)
                With .Points(intPoint)
                    .MarkerBackgroundColor = Spectrum.SpectrumColor(lngIndex)
                    .MarkerForegroundColor = Spectrum.SpectrumColor(lngIndex)
                End With
            Next
        End With
    End With
    
End Sub
Sub UsingCustomMarkers(Spectrum As CSpectrum, Cht As Chart)
'
' Use a shape as a custom marker
'
    Dim shpMarker As Shape
    Dim lngIndex As Long
    Dim intPoint As Integer
    
    Application.ScreenUpdating = False
    Set shpMarker = ActiveSheet.Shapes("Marker")
    With Cht
        With .SeriesCollection(1)
            For intPoint = 1 To .Points.Count
                lngIndex = intPoint * (Spectrum.Count / .Points.Count)
                shpMarker.Fill.ForeColor.RGB = Spectrum.SpectrumColor(lngIndex)
                shpMarker.CopyPicture
                .Points(intPoint).Paste
            Next
        End With
    End With
    Application.ScreenUpdating = True
    
End Sub

Option Explicit

Private Enum enumSpectrum
    Red = 1
    Green
    Blue
End Enum

Private m_lngStart Color As Long
Private m_lngEndColor As Long
Private m_lngCountColor As Long
Private m_lngSpectrum() As Long
Private m_blnUpdatedSpectrum As Boolean
Public Property Let Count(RHS As Long)
    If RHS < 1 Then
        m_lngCountColor = 1
    ElseIf RHS > 255 Then
        m_lngCountColor = 255
    Else
        m_lngCountColor = RHS
    End If
    
    m_blnUpdatedSpectrum = False
End Property
Public Property Get Count() As Long
    Count = m_lngCountColor
End Property
Public Sub CreateSpectrum()
'
' Calculate the spread of colours
'
    Dim lngIndex As Long
    Dim lngColor As Long
    Dim sngSpreadRed As Single
    Dim sngSpreadGreen As Single
    Dim sngSpreadBlue As Single
    Dim sngRed As Single
    Dim sngGreen As Single
    Dim sngBlue As Single
    
    If m_lngCountColor = 0 Then
        m_lngCountColor = 2
        ReDim m_lngSpectrum(m_lngCountColor) As Long
        m_lngSpectrum(1) = m_lngStart Color
        m_lngSpectrum(2) = m_lngEndColor
        m_blnUpdatedSpectrum = True
    End If
    
    ReDim m_lngSpectrum(m_lngCountColor) As Long
    m_lngSpectrum(1) = m_lngStart Color
    m_lngSpectrum(m_lngCountColor) = m_lngEndColor
    sngRed = CSng(m_Color2RGB(m_lngSpectrum(1), Red))
    sngGreen = CSng(m_Color2RGB(m_lngSpectrum(1), Green))
    sngBlue = CSng(m_Color2RGB(m_lngSpectrum(1), Blue))
    
    sngSpreadRed = (m_Color2RGB(m_lngSpectrum(m_lngCountColor), Red) - sngRed) / m_lngCountColor
    sngSpreadGreen = (m_Color2RGB(m_lngSpectrum(m_lngCountColor), Green) - sngGreen) / m_lngCountColor
    sngSpreadBlue = (m_Color2RGB(m_lngSpectrum(m_lngCountColor), Blue) - sngBlue) / m_lngCountColor
    
    For lngIndex = 2 To m_lngCountColor - 1
        sngRed = sngRed + sngSpreadRed
        sngGreen = sngGreen + sngSpreadGreen
        sngBlue = sngBlue + sngSpreadBlue
        m_lngSpectrum(lngIndex) = RGB(CInt(sngRed), CInt(sngGreen), CInt(sngBlue))
    Next
    
    m_blnUpdatedSpectrum = True
    
End Sub
Private Function m_Color2RGB(Color As Long, Element As enumSpectrum) As Long
'
' Return RGB element for given color
'
    Select Case Element
    Case enumSpectrum.Red
        m_Color2RGB = Color \ 256 ^ 0 And 255
    Case enumSpectrum.Green
        m_Color2RGB = Color \ 256 ^ 1 And 255
    Case enumSpectrum.Blue
        m_Color2RGB = Color \ 256 ^ 2 And 255
    End Select
    
End Function

Public Property Get SpectrumColor(Index As Long) As Long
    If Index > m_lngCountColor Then
        SpectrumColor = m_lngSpectrum(m_lngCountColor)
    ElseIf Index < 1 Then
        SpectrumColor = m_lngSpectrum(1)
    Else
        SpectrumColor = m_lngSpectrum(Index)
    End If
End Property
Public Property Let Start Color(RHS As Long)
    m_lngStart Color = RHS
    m_blnUpdatedSpectrum = False
End Property
Public Property Let EndColor(RHS As Long)
    m_lngEndColor = RHS
    m_blnUpdatedSpectrum = False
End Property
Public Property Get Start Color() As Long
    Start Color = m_lngStart Color
End Property
Public Property Get EndColor() As Long
    EndColor = m_lngEndColor
End Property
Private Sub Class_Initialize()

    ' default settings
    m_lngCountColor = 56
    m_lngStart Color = RGB(0, 0, 255)  ' blue
    m_lngEndColor = RGB(255, 0, 0)    ' red
    m_blnUpdatedSpectrum = False
    CreateSpectrum
    
End Sub