VBA Excel, Hyperlink to Google Earth (Google Earth API)
This article explains how you can create a hyperlink in Excel to a google earth location. When the user clicks on the hyperlink google earth will launch and move to the specified location.
In the figure below you can see the excel sheet with the hyperlinks:
In column B there is the address of KML files. Upon clicking a hyperlink, google earths camera will be set to the location specified by the KML file:
Contents
Step 1:
In order for the code in this article to work you will need to add reference to the following libraries:
- Microsoft XML ( i.e Microsoft XML V6.0)
- Google Earth 1.0 Type Library
I have explained about setting the camera in the article below:
Step 2:
Create a new module and copy the code below inside it:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Step 3:
Copy the following code in the Sheet1 object:
'google earth application
Dim objGoogle As EARTHLib.ApplicationGE
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'Microsoft XML Object
Dim objXML As MSXML2.DOMDocument60
'KML Data
Dim dblLong As Double
Dim dblLat As Double
Dim dblAlt As Double
Dim dblHeading As Double
Dim dbltitl As Double
Dim dblrange As Double
Dim straltiMode As String
Dim objNode As MSXML2.IXMLDOMNode
Dim objAltMode As EARTHLib.AltitudeModeGE
'hyperlink location
Dim strPath As String
'automate obejcts
Set objXML = New MSXML2.DOMDocument60
'automate google earth if its already open
If objGoogle Is Nothing Then
Set objGoogle = New EARTHLib.ApplicationGE
Sleep 5000
Else
'if its open press Alt+Tab
SendKeys ("%{Tab}")
End If
'get KML Data
strPath = Cells(Selection.Row, 2)
objXML.Load (strPath)
Set objNode = objXML.ChildNodes.Item(1).ChildNodes.Item( _
0).ChildNodes.Item(4).ChildNodes.Item(1)
dblLong = objNode.ChildNodes.Item(0).Text
dblLat = objNode.ChildNodes.Item(1).Text
dblAlt = objNode.ChildNodes.Item(2).Text
dblHeading = objNode.ChildNodes.Item(3).Text
dbltitl = objNode.ChildNodes.Item(4).Text
dblrange = objNode.ChildNodes.Item(5).Text
straltiMode = objNode.ChildNodes.Item(6).Text
If straltiMode = "relativeToSeaFloor" Then
objAltMode = AbsoluteAltitudeGE
Else
objAltMode = RelativeToGroundAltitudeGE
End If
'set camera
Call objGoogle.SetCameraParams(dblLat, dblLong, dblAlt, _
objAltMode, dblrange, dbltitl, 0, 0.7)
End Sub
Most of the code above has already been explained in the article below:
The google earth application object has been declared as a global variable. This enables us to keep reference to the open google earth application.
The function above is declared inside an event handler. The event handler executes when someone clicks on a hyperlink inside the worksheet:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
The hyperlinks themselves are not connected to anything. They are linked to the cell they are in:
The code below checks if the google earth application has already been automated or not. If it hasn’t been automated a new object will be created. If it has already been automated Alt+Tab will be pressed to bring focus to the application:
If objGoogle Is Nothing Then
Set objGoogle = New EARTHLib.ApplicationGE
Sleep 5000
Else
'if its open press Alt+Tab
SendKeys ("%{Tab}")
End If
You can download the file and code used in this article from the link below:
See also Application.SendKeys Explained
3 thoughts on “VBA Excel, Hyperlink to Google Earth (Google Earth API)”