Excel VBA Tutorial - Using VBA to show blinking symbol on a Map

 

 

Excel VBA Tutorial - Using VBA to show blinking symbol on a Map | Cemtech Training Center Puchong Selangor, Melaka

 

My colleague Ms. Chee SK (LinkedIn) conducted an Excel Executive Training for a corporate Singapore-based customer recently. They need to use Excel to indicate which MRT station is the nearest to their customer's location or customer specified landmark. Example, for a landmark called WestMall, the nearest MRT station is Bukit Batok. A symbol shall be displayed and blinking on a MRT map. 

 

I then explore the possibility to use Excel VBA to accomplish this. Here are my work.


1. First, put the map image on a worksheet called Map.
 

2. Select the cell below the map, example cell D15, which is closest to Bukit Batok. Set the Name to "BukitBetok".
 

Excel VBA Tutorial - Using VBA to show blinking symbol on a Map | Cemtech Training Center Puchong Selangor, Melaka

 

3. Put a graphic. Set the Name to "myoutlet".
 

Excel VBA Tutorial - Using VBA to show blinking symbol on a Map | Cemtech Training Center Puchong Selangor, Melaka

 

4. You have another worksheet, that have many landmarks, next of the WestMall landmarks, put a hyperlink to jump to named cell "BukitBatok".
 

 Excel VBA Tutorial - Using VBA to show blinking symbol on a Map | Cemtech Training Center Puchong Selangor, Melaka

Excel VBA Tutorial - Using VBA to show blinking symbol on a Map | Cemtech Training Center Puchong Selangor, Melaka

 

 5. Here is fun part. When the cursor is at "BukitBetok" cell due to the hyperlink. We need VBA to detect there is SelectionChange happens. It then check whether the cell has Name. I have Outletname function to check the availability of the Name. If yes, it moves the "myoutlet" symbol to the cell. Plus, we need the symbol to blink few seconds. I have Blinking subroutine to do blinking.


Here is the code in the Map worksheet module.

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Select Case Outletname(Target)

Case "BukitBatok"
Worksheets("Map").Shapes("myoutlet").Top = Target.Top
Worksheets("Map").Shapes("myoutlet").Left = Target.Left
Blinking

Case Else
Worksheets("Map").Shapes("myoutlet").Top = Worksheets("Map").Range("T1").Top
Worksheets("Map").Shapes("myoutlet").Left = Worksheets("Map").Range("T1").Left

End Select

End Sub

 

Sub Blinking()

Dim n As Integer
Dim mytime

For n = 1 To 20
Worksheets("Map").Shapes("myoutlet").Visible = Not Worksheets("Map").Shapes("myoutlet").Visible
mytime = Time + 1 / 60 / 60 / 24
'Wait 1 sec.
While mytime > Time
DoEvents
Wend
Next

End Sub

Function Outletname(Target As Range) As String


On Error Resume Next
Dim nm As Name, r As Range

Outletname = ""
For Each nm In Application.Names
Set r = Application.Intersect(Target, Range(nm.Name))
If Not r Is Nothing Then
Outletname = nm.Name
Exit For
End If
Next nm

End Function

 

6. For other MRT stations, you can repeat step 4. And, don't forget also, in the SelectionChange subroutine, add the case clause for the new station.

Case "XXX"
Worksheets("Map").Shapes("myoutlet").Top = Target.Top
Worksheets("Map").Shapes("myoutlet").Left = Target.Left
Blinking

 

By Liang Ee Hang  | LinkedIn

Cempaka Technology Sdn Bhd

Pusat Latihan Komputer Cempaka
~Your HRDC Premiere Training Provider~
Unit 6, Level 4, SetiaWalk Mall (Block K), SetiaWalk, Persiaran Wawasan, Pusat Bandar Puchong, 47160 Puchong, Selangor, Malaysia.
Tel: 603-80684461, Fax: 603-80684240
1-28, Jalan PM4, Plaza Mahkota, 75000 Melaka, Malaysia
Tel: 606-2835955, Fax: 606-2845955