AJP Excel Information AJP Excel Information
Content
 
 

XY scatter colouration plot

 
The chart in both cases is a standard xy scatter plot where the plot order of each data point determines the colour of the marker.
The first chart sets the data markers colour but due to the limit of the colour palette it produces a more stepped colouration.

 

The second chart uses an autoshape as a custom marker. The colour of the custom marker is not restricted by the colour palette so the colouration is smoother.

The code sets the data markers colour according to the points order within the data series.
You can specify the start and finish colours and the number of steps between.
 
In order for the code below to work you will need to create 2 charts and insert a autoshape onto a worksheet. The autoshape should be named Marker.

To name the autoshape select it and enter the new name in the Name box next to the formula bar.

The code allows you to specify the start and finish colour of your spectrum. You can also specify the number of colours to define within the span.
 
Code module: MSpectrum
Option Explicit

Sub Main()

    
Dim clsSpectrum As CSpectrum
    
    
Set clsSpectrum = New CSpectrum
    
With clsSpectrum
        .Count = 56                       ' number of colours in spectrum
        .StartColor = 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
 
Class module: CSpectrum
Zilpher Coloured Code
Option Explicit

Private Enum enumSpectrum
    Red = 1
    Green
    Blue
End Enum

Private m_lngStartColor 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_lngStartColor
        m_lngSpectrum(2) = m_lngEndColor
        m_blnUpdatedSpectrum = 
True
    End If
    
    
ReDim m_lngSpectrum(m_lngCountColor) As Long
    m_lngSpectrum(1) = m_lngStartColor
    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 
StartColor(RHS As Long)
    m_lngStartColor = RHS
    m_blnUpdatedSpectrum = 
False
End Property
Public Property Let 
EndColor(RHS As Long)
    m_lngEndColor = RHS
    m_blnUpdatedSpectrum = 
False
End Property
Public Property Get 
StartColor() As Long
    StartColor = m_lngStartColor
End Property
Public Property Get 
EndColor() As Long
    EndColor = m_lngEndColor
End Property
Private Sub 
Class_Initialize()

    ' default settings
    m_lngCountColor = 56
    m_lngStartColor = RGB(0, 0, 255)  
' blue
    m_lngEndColor = RGB(255, 0, 0)    ' red
    m_blnUpdatedSpectrum = False
    CreateSpectrum
    
End Sub
 
 
 
 
 
The code and charts are contained within this example workbook
 
 
 
   

Last updated 28th April 2007


Created August 2004
Last updated 5th August 2014 


Return to main page Chart Section VBA section Fun and games section Forum files Tips section Links section Book section Site information Site Search RSS feed Top of page


Microsoft® and Microsoft® Excel are registered trademarks of the Microsoft Corporation.
andypope.info is not associated with Microsoft. Copyright ©2007-2014 Andy Pope