Interactive Excel Maps - part 1

Introduction

I've recently been trying to get some interactive maps working in Excel for a dashboard we were using at work.

What follows is the first part of an explanation of how I did it and an example of what it looks like.

Of course I could have created the maps much more simply in R or Quantum GIS but that wouldn't have helped for the dashboard.



The macro creates a new worksheet and lists the regions from the map file in the first two columns, starting at row 2. Column 1 holds the region names, column 2 will hold the data that defines the colour of the region that has that name. The data can have values between 0 and 1; any other data will have to be scaled to this range. On entering data the colour of the relevant region will be updated.

The macro then creates a bar chart from the data held in columns 1 and 2. A background is placed over the chart and the shapes corresponding to the coordinates for the map are drawn on this background.

The map data for this was extracted from the list of map data held on ONS Geoportal. I used Quantum GIS to load the shape files and then extracted them in an SVG format. From this, I deleted all the extraneous detail and was left with a region name and a list of coordinates. The actual format of the map data is largely irrelevant. Any map data can be used, as long as it can be converted to a list of coordinates to create the shapes. In my case, I used a UTF-16 format for the files as I was working with Spanish data.

To create the interactivity for the chart, I created a custom class. This class overrides the calculate and select events of the chart. The data for the chart is set to the data for the regions. When this data is changed the chart, and the shapes on the chart, are updated. Selecting a shape changes the border to yellow. Obviously more can be done to the select event so that, for example, more data is displayed on the chart or a line chart created on the map.

Saving and closing the sheet breaks the link between the chart and the interactivity. Therefore macros were written to re-enable these events.

The Code

For this map, 5 classes need to be defined. They are:

1. MapEvent - this overrides the Excel application events so that events on map charts can be enabled.
2. MapChart - this class defines the properties of the map and overrides some of the chart events to allow the interactivity of the chart.
3. Region - this holds details of a region to be mapped such as name, the initial colour of the region, whether it should be filled and how many sub-regions there are defining the region.
4. Region_Bit - this holds the actual points of the region, as well as the start point and the name.
5. MapPoint2D - holds the x and y coordinates of the point.

These are all tied together with 5 subroutines. 4 of these set up the events and the fifth creates the map.

All the code can be downloaded from my add-in on the website www.sciolist.weebly.com.

MapChart

To enable events on chart objects a class must be created that defines the events and states that the class has events.

Two events are over-ridden - the calculate and the select events. The calculate one is used to update the map colours based on the data. The select event changes the border to yellow for the selected region and deselects the region by selecting the background.

-------------------------------------------------------------------------------
Option Explicit

Public WithEvents MapChart As Chart
Public srcDataRange As range            'Range holding data for chart
Public reg_shapes As VBA.Collection     'Doesn't seem to be used - change to a boolean?
Public scale_low_red As Integer
Public scale_low_green As Integer
Public scale_low_blue As Integer
Public scale_high_red As Integer
Public scale_high_green As Integer
Public scale_high_blue As Integer

Private Sub MapChart_Calculate()
    'Recalculate all colours
    Dim i As Integer
    Dim j As Double
    Dim k As String
    Dim dd As New Dictionary
    Dim cr As Integer
    Dim cg As Integer
    Dim cb As Integer
    
    If Not reg_shapes Is Nothing Then
        'Populate dictionary with data from sheet
        j = srcDataRange.Rows.Count
        For i = 1 To srcDataRange.Rows.Count
            dd.Add srcDataRange(i, 1).Value, srcDataRange(i, 2).Value
        Next
    
        For i = 1 To Me.MapChart.Shapes.Count
            If dd.Exists(Me.MapChart.Shapes(i).name) Then
                'Calculate colour
                j = dd.Item(Me.MapChart.Shapes(i).name)
                cr = (scale_high_red - scale_low_red) * j + scale_low_red
                cg = (scale_high_green - scale_low_green) * j + scale_low_green
                cb = (scale_high_blue - scale_low_blue) * j + scale_low_blue
                Me.MapChart.Shapes(i).fill.ForeColor.RGB = RGB(cr, cg, cb)
                
            End If
        Next
    End If
End Sub

Private Sub MapChart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
    Dim i As Integer
    
    If Left(Selection.name, 3) <> "Map" Then
        
        'Reset other borders to black
        For i = 1 To Me.MapChart.Shapes.Count
            Me.MapChart.Shapes(i).Line.ForeColor.RGB = RGB(0, 0, 0)
            If Selection.name = Me.MapChart.Shapes(i).name Then
                Me.MapChart.Shapes(Selection.name).Line.ForeColor.RGB = RGB(255, 255, 0)
            End If
        Next
        
        'Change border to yellow if not the background
        For i = 1 To Me.MapChart.Shapes.Count
            If Selection.name = Me.MapChart.Shapes(i).name And Selection.name <> "Background" Then
                Me.MapChart.Shapes(Selection.name).Line.ForeColor.RGB = RGB(255, 255, 0)
                Me.MapChart.Shapes(Selection.name).ZOrder (msoBringToFront)
            End If
        Next
        
        'Select the 'map'
        Me.MapChart.Parent.Select
    End If
End Sub

Public Sub SetScaleLow(red As Long, green As Long, blue As Long)
    scale_low_red = red
    scale_low_green = green
    scale_low_blue = blue
End Sub

Public Sub SetScaleHigh(red As Long, green As Long, blue As Long)
    scale_high_red = red
    scale_high_green = green
    scale_high_blue = blue

End Sub
-------------------------------------------------------------------------------

MapEvent

This class merely defines the application level events for the maps. This is so we can re-enable events (or disable them) if we have saved the workbook or opened a previously saved workbook.

-------------------------------------------------------------------------------

Option Explicit

Public WithEvents EventApp As Excel.Application

 

Private Sub EventApp_SheetActivate(ByVal Sh As Object)

    Set_All_Maps

End Sub

 

Private Sub EventApp_SheetDeactivate(ByVal Sh As Object)

    Reset_All_Maps

End Sub

 

Private Sub EventApp_WorkbookActivate(ByVal Wb As Workbook)

    Set_All_Maps

End Sub

 

Private Sub EventApp_WorkbookDeactivate(ByVal Wb As Workbook)

    Reset_All_Maps

End Sub

-------------------------------------------------------------------------------

Region

This class defines the properties of a region. These are the name, the sub-regions and the initial colour.

-------------------------------------------------------------------------------

Option Explicit

Private region_name As String

Private bits As New VBA.Collection

Private reg_colour(3) As Integer

Private rcol As Long

Private fill As Boolean

'Set region name

Public Sub setName(name As String)

    region_name = name

End Sub

'Get region name

Public Function getName() As String

    getName = region_name

End Function

'Add region bit

Public Sub addBit(bit As Region_Bit)

    bits.Add bit

End Sub

'Get region bit

Public Function getBit(i As Integer) As Region_Bit

    Set getBit = bits.Item(i)

End Function

'Set colour

Public Sub setColour(red As Integer, green As Integer, blue As Integer)

    reg_colour(1) = red

    reg_colour(2) = green

    reg_colour(3) = blue

    rcol = RGB(red, green, blue)

End Sub

'Get colour

Public Function getColour() As Double()

    getColour = reg_colour

End Function

Public Function getColour2() As Long

    getColour2 = rcol

End Function

'Get number of bits

Public Function getNumBits() As Integer

    getNumBits = bits.Count

End Function

Public Sub setFill(f As Boolean)

    fill = f

End Sub

Public Function getFill() As Boolean

    getFill = fill

End Function

-------------------------------------------------------------------------------

Region_Bit

These are the individual parts that make up the region. Generally these are islands and other non-continuous parts. The class holds the individual points.

-------------------------------------------------------------------------------

Option Explicit

Private name As String

Private start_Point As MapPoint2D

Private pnts As VBA.Collection

Private Sub Class_Initialize()

    Set pnts = New VBA.Collection

    'Set start_Point = New MapPoint2D

End Sub

Public Sub addPoint(temp As MapPoint2D)

    pnts.Add temp

End Sub

Public Sub setName(temp As String)

    name = temp

End Sub

Public Function getName() As String

    getName = name

End Function

Public Function getNumber() As Integer

    getNumber = pnts.Count

End Function

Public Function getPoint(temp As Integer) As MapPoint2D

    Set getPoint = pnts.Item(temp)

End Function

Public Sub setStartPoint(ByVal temp As MapPoint2D)

    Set start_Point = temp

End Sub

Public Function getStartPoint() As MapPoint2D

    Set getStartPoint = start_Point

End Function

Public Function getNumPoints() As Integer

    getNumPoints = pnts.Count

End Function

-------------------------------------------------------------------------------

MapPoint2D

This class holds the x and y coordinates of the individual points. It's fairly simple.

-------------------------------------------------------------------------------

Option Explicit

Private x As Double

Private y As Double

Public Sub SetX(temp As Double)

    x = temp

End Sub

Public Sub SetY(temp As Double)

    y = temp

End Sub

Public Function GetX() As Double

    GetX = x

End Function

Public Function GetY() As Double

    GetY = y

End Function

-------------------------------------------------------------------------------

Until Part 2

That's it for part 1. I'll leave it there for the moment. In part 2, I'll detail the code needed to load the data and actually draw the map in Excel. Until then.