Creating a game board in Excel

The following code creates the board starting at (xo, yo) and with squares of size side. Each square is named based on the coordinates (you can choose your own method for this but I've just used 0-63. Equally you could name them by their chess coords A1-H8). The colour of the square is chosen to alternate like a chess board. You can change the border colour also as required. Finally, the "action" (what happens when it is clicked) is set to call the macro "click" which in this example simply displays a message box with the square name.

Sub CreateBoard()
Const side = 50
Const xo = 200
Const yo = 50

Dim x As Integer, y As Integer

    For y = 0 To 7
        For x = 0 To 7
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                xo + x * side, yo + y * side, side, side).Select
            Selection.Name = "square" & x + y * 8
            Selection.OnAction = "click"
            
            If (x + y) Mod 2 = 1 Then
                Selection.ShapeRange.Fill.ForeColor.RGB = _
                     RGB(0, 0, 0)
                Selection.ShapeRange.Line.ForeColor.RGB = _
                     RGB(0, 0, 0)
            Else
                Selection.ShapeRange.Fill.ForeColor.RGB = _
                    RGB(200, 200, 200)
                Selection.ShapeRange.Line.ForeColor.RGB = _
                    RGB(200, 200, 200)
            End If
        Next
    Next
End Sub

Sub click()
    MsgBox Application.Caller

End Sub

Download Excel file here: 20140404 - BoardGameEx.xlsm

Goto a place in a workbook by clicking on a shape

It's simple to redirect to a section in a workbook by adding a hyperlink, but the position of the cursor on the screen could be anywhere depending on where it is coming from. To get the cursor nicely aligned at the top of the screen use the following macro:

Sub GotoSection()
Dim rng As Range

    On Error Resume Next

    Set rng = Range("rng" & Mid(Application.Caller, 4, _
        Len(Application.Caller) - 3))
    rng.Worksheet.Activate
    ActiveWindow.ScrollRow = rng.Row
    ActiveSheet.Cells(rng.Row, 1).Select
End Sub

Create a shape (although it will work with buttons etc.) and assign this macro to it. Then create a named range in the cell you want to reference and prefix it with "rng". The code above assumes a three letter prefix for the name of the calling object - in my case it is "shp" because I'm using shapes as the "buttons" for the user to click on.

The macro above strips the first 3 letters and replaces them with "rng" to create the name of the range it is looking for. It then activates the sheet that this range is on, scrolls to the relevant row and selects it.

You can use any other kind of mapping from the shape (or other object) name to identify the relevant range, including simply using a select statement, but having a "translation algorithm" it makes it easy to just add another shape and another range and everything works.

One final tip: if you want to reference the same range from more than one place, you will need to copy the shape that references it. You can then change the appearance and text of the shape as required.

Adding click-to-update "Traffic lights" to a dashboard

Traffic light dashboards

I sometimes need to create dashboards that represent the status of a number of elements. Perhaps it could represent some important information about key customers as below:





This looks nice, but every time you need to update the status of an element, you need to fiddle about with the colour of the shape. The code below avoids this by linking a click on a shape to a macro that cycles through the colours. In the example below I have 4 colours: red, amber, green and white, which represents undefined.

Create a single Oval shape and assign the macro below to it:

Sub RotateRAGColour()
Const cWhite = 16777215
Const cGreen = 5287936
Const cAmber = 49407
Const cRed = 192
Dim shp As Shape

    Set shp = ActiveSheet.Shapes(Application.Caller)
    
    Select Case shp.Fill.ForeColor.RGB
        Case cWhite
            shp.Fill.ForeColor.RGB = cGreen
        Case cRed:
            shp.Fill.ForeColor.RGB = cWhite
        Case cAmber:
            shp.Fill.ForeColor.RGB = cRed
        Case cGreen:
            shp.Fill.ForeColor.RGB = cAmber
        
    End Select
End Sub

This cycles through the colours White-Green-Orange-Red. Copy the shape as many times as you need to create the dashboard. The following macro centres the shapes in the cell they are in:

Sub CentreTrafficLights()
Dim shp As Shape

    For Each shp In ActiveSheet.Shapes
        If shp.AutoShapeType = msoShapeOval Then
            Set rng = shp.TopLeftCell
            shp.Left = rng.Left + (rng.Width - shp.Width) / 2
            shp.Top = rng.Top + (rng.Height - shp.Height) / 2
        End If
    Next
End Sub