使用Excel VBA編程將網點的百度座標轉換後標註到高德地圖上

時間 2019-11-06

標籤使用 excel vba 編程網點百度座標轉換標註地圖欄目 Microsoft Office 简体版

原文原文鏈接

公司網點表存儲的座標是百度座標，現須要將網點位置標註到高德地圖上，研究了一下高德地圖的雲圖數據模版 http://lbs.amap.com/yuntu/reference/cloudstorage和座標轉換服務http://lbsbbs.amap.com/forum.php?mod=viewthread&tid=724，雲數據管理平臺http://yuntu.amap.com/datamanager/ ，實現了excel文件的導入，現將實現步驟及使用的一些技巧總結一下：javascript

本地數據導出爲高德雲圖導出模版須要的excel文件

由於須要轉爲高德地圖對應的座標，高德提供了座標轉換的接口服務（http://lbsbbs.amap.com/forum.php?mod=viewthread&tid=724），我想直接使用excel裏的vba編程實現座標的轉換。php

上面的文件導出後生成excel文件，紅色的是模版必填的內容，藍色的是選填的，爲了後面其它應用的須要，我將對應的code和Id也存入到模版中java

Excel VBA編程實現座標轉換

高德提供的座標轉換服務接口：http://restapi.amap.com/v3/assistant/coordinate/convert?locations=116.481499,39.990475&coordsys=baidu&output=Json&key=dd21bdd2263294d9e11b4a9f9d5d6c71編程

只要傳入對應的座標便可返回高德座標（coordsys可選值：gps;mapbar;baidu）,經過瀏覽器訪問將返回以下格式數據，其中locations值就是對應的高德座標。json

根據這個接口，我使用Excel的VBA編程來實現接口請求和座標轉換，具體實現參考下面的截圖api

須要引用的對象如上圖。瀏覽器

Function BytesToBstr(body, code)
    Dim objstream
    Set objstream = CreateObject("adodb.stream")
    objstream.Type = 1
    objstream.Mode = 3
    objstream.Open
On Error Resume Next
    objstream.Write body
On Error GoTo 0
    objstream.Position = 0
    objstream.Type = 2
    objstream.Charset = code
    BytesToBstr = objstream.ReadText
    objstream.Close
    Set objstream = Nothing
End Function

Function GetGaoDeLocations(XmlStr As String) As String
Dim objHTTP, xmlDOC

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Set xmlDOC = CreateObject("MSXML.DOMDocument")
strWebserviceURL = "http://restapi.amap.com/v3/assistant/coordinate/convert?coordsys=baidu&output=json&key=dd21bdd2263294d9e11b4a9f9d5d6c71&locations=" & XmlStr
objHTTP.Open "GET", strWebserviceURL, False '默認是POST方式
objHTTP.setRequestHeader "Content-Type", "application/json"
objHTTP.send ("")
'objHTTP.send ("{locations:'" & XmlStr & "'}") 'XmlInput是Ws的參數
GetGaoDeLocations = CStr(BytesToBstr((objHTTP.responseBody), "utf-8"))

Dim objSC, strJSON, objJS
strJOSN = GetGaoDeLocations
 '調用ScriptControl對象
Set objSC = CreateObject("MSScriptControl.ScriptControl")
strJSON = "var o=" & strJOSN & ";"
objSC.Language = "javascript"
objSC.AddCode (strJSON)
Set objJS = objSC.CodeObject.o
GetGaoDeLocations = objJS.locations

End Function

VBA裏的代碼如上，實現接口請求及返回值的處理。app

經過拖動實現文本框內容的自動填充，拖動過程當中，就自動去調用接口返回對應的高德座標。函數

通過一番座標轉換後，須要再將返回值分割成經度和緯度分別填充到X,Y列。關於字符串分割，參考下面的方法：取左側經度=LEFT(C2,FIND(",",C2)-1)，取右側緯度的=RIGHT(C2,LEN(C2)-LEN(D2)-1)spa

怎麼樣能夠從一串字符中的某個指定位置的前或後截取指定個數的字符.

如:12345.6789,我要截取小數點前(或後)的3個字符.怎麼樣操做,

另外,怎麼樣從右邊截取字符,就是和left()函數相反的那個功能.

=find(".",a2)
返回在數字中字符（小數點）的位置。

具體公式以下：
字符（小數點）前三位
=MID(A2,FIND(".",A2)-3,3)

字符（小數點）後三個
=MID(A2,FIND(".",A2)+1,3)

字符（小數點）前面的全部數字

=LEFT(A2,FIND(".",A2)-1)

字符（小數點）後面的全部數字

=RIGHT(A2,FIND(".",A2)-2)

以上均爲不包括「字符」的狀況。其它狀況只需改變一下紅色數字大小。