Excelに入力された位置情報データを用いて,Google Earth上にプレイスマークをプロットさせることが出来れば,簡易なGISとして活用することが可能となります。以下では,橋梁の点検結果から評価した健全度をマッピングしてみることにします。
目次
はじめに
ケーススタディ
橋梁の健全度マップを作成するケーススタディを行います。緯度経度はある自治体の橋梁位置の一部を拝借しましたが,ケーススタディのため,橋梁名,健全度ランクは適当です。
動作確認状況
Excel | 32ビット | 64ビット |
---|---|---|
2007 | OK | – |
2010 | たぶんOK(未確認) | たぶんOK(未確認) |
2011 Mac | NG | – |
2013 | OK | OK |
2007, 2013の32ビットでしか動作確認していませんが、Win32APIを用いていないので、おそらく64ビットでもそのまま動くでしょう。
2007, 2013の32ビットおよび2013の64ビットで動作確認しました。MSXMLの参照設定があるため、2011 Macでは動作しません。
データの準備
上図のように,’Sheet1′ 上に ‘テーブル1’ を作成し,列として「橋梁名」「緯度」「経度」「ランク」を設定します。この場合のランクは下表の様に設定しています。
健全度ランク | 橋梁の健全性 | マーク |
1 | 健全で補修の必要がない | ![]() |
2 | 損傷があり,計画的な補修が必要 | ![]() |
3 | 損傷が大きく,緊急的な対応が必要 | ![]() |
モジュールの作成
標準モジュールにパブリックプロシージャを1つ作成します。
何をするプロシージャか
Excelのテーブルから橋梁名、位置情報(緯度、経度)、健全度を取得して、健全度別に色が異なるアイコンのプレイスマークをkmlファイルとして作成し、Google Earth上にプロットします。
プロシージャのコード
ケーススタディのため,実行部分のソースコードのみ記載します。ボタンやメニューは必要に応じて作成して下さい。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 |
Option Explicit Sub LaunchGoogleEarth() 'エクセルのデータを加工してGoogle Earthに表示 '使用するテーブルを指定 Dim lst As ListObject Set lst = ThisWorkbook.Worksheets("Sheet1").ListObjects("テーブル1") 'XMLファイルを作成 要参照設定 Microdoft XML, v6.0 Dim XmlDoc As MSXML2.DOMDocument60 Set XmlDoc = New MSXML2.DOMDocument60 'XML宣言を設定 Dim xmlPI As MSXML2.IXMLDOMProcessingInstruction Set xmlPI = XmlDoc.appendChild(XmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")) 'kmlルートノードを設定 Dim RootNode As MSXML2.IXMLDOMElement Set RootNode = XmlDoc.createElement("kml") Set XmlDoc.DocumentElement = RootNode 'kmlドキュメント設定 Dim DocumentElement As MSXML2.IXMLDOMElement Dim tmpElement As MSXML2.IXMLDOMElement Set DocumentElement = AddElement(XmlDoc, RootNode, "Document") Set tmpElement = AddElement(XmlDoc, DocumentElement, "name", "Temporary") 'マーカースタイル設定 Dim Style As Variant Dim StyleElement As MSXML2.IXMLDOMElement Dim PairElement As MSXML2.IXMLDOMElement Dim IconStyleElement As MSXML2.IXMLDOMElement Dim IconElement As MSXML2.IXMLDOMElement For Each Style In Array("red", "grn", "ylw") Set StyleElement = AddElement(XmlDoc, DocumentElement, "StyleMap", , "id", "msn_" & Style & "-pushpin") Set PairElement = AddElement(XmlDoc, StyleElement, "Pair") Set tmpElement = AddElement(XmlDoc, PairElement, "key", "normal") Set tmpElement = AddElement(XmlDoc, PairElement, "styleUrl", "#sn_" & Style & "-pushpin") Set PairElement = AddElement(XmlDoc, StyleElement, "Pair") Set tmpElement = AddElement(XmlDoc, PairElement, "key", "highlight") Set tmpElement = AddElement(XmlDoc, PairElement, "styleUrl", "#sh_" & Style & "-pushpin") Set StyleElement = AddElement(XmlDoc, DocumentElement, "Style", , "id", "sn_" & Style & "-pushpin") Set IconStyleElement = AddElement(XmlDoc, StyleElement, "IconStyle") Set tmpElement = AddElement(XmlDoc, IconStyleElement, "scale", "1.1") Set IconElement = AddElement(XmlDoc, IconStyleElement, "Icon") Set tmpElement = AddElement(XmlDoc, IconElement, "href", "http://maps.google.com/mapfiles/kml/pushpin/" & Style & "-pushpin.png") Set tmpElement = AddElement(XmlDoc, IconStyleElement, "hotSpot", , "x", "20", "y", "2", "xunits", "pixels", "yunits", "pixels") Set StyleElement = AddElement(XmlDoc, DocumentElement, "Style", , "id", "sh_" & Style & "-pushpin") Set IconStyleElement = AddElement(XmlDoc, StyleElement, "IconStyle") Set tmpElement = AddElement(XmlDoc, IconStyleElement, "scale", "1.3") Set IconElement = AddElement(XmlDoc, IconStyleElement, "Icon") Set tmpElement = AddElement(XmlDoc, IconElement, "href", "http://maps.google.com/mapfiles/kml/pushpin/" & Style & "-pushpin.png") Set tmpElement = AddElement(XmlDoc, IconStyleElement, "hotSpot", , "x", "20", "y", "2", "xunits", "pixels", "yunits", "pixels") Next Style 'テーブルの内容によってプレイスマークを追加 Dim Bridge As Variant Dim R As Long Dim BridgeName As String Dim lat As Double, lng As Double Dim lng_lat As String Dim lRank As Long, sRank As String Dim Desc As String Dim PlacemarkElement As MSXML2.IXMLDOMElement Dim PointElement As MSXML2.IXMLDOMElement Dim LookAtElement As MSXML2.IXMLDOMElement With lst 'テーブルで見えている橋を対象(フィルタで隠したものは表示しない) For Each Bridge In .ListColumns("橋梁名").DataBodyRange.SpecialCells(xlCellTypeVisible) R = Bridge.Row '対象の橋の行番号 BridgeName = .ListColumns("橋梁名").Range(R) '橋梁名 lat = .ListColumns("緯度").Range(R) '緯度 lng = .ListColumns("経度").Range(R) '経度 lng_lat = CStr(lng) & "," & CStr(lat) & ",0" '緯度+経度+高度(0) lRank = .ListColumns("ランク").Range(R) 'ランク(整数) 'ランクに対応するスタイルマップを指定 Select Case lRank Case 1: sRank = "#msn_grn-pushpin" Case 2: sRank = "#msn_ylw-pushpin" Case 3: sRank = "#msn_red-pushpin" End Select 'ポップアップで出す説明文(HTML)を設定 Desc = "橋梁名:" & BridgeName & "<br/>" & "ランク:" & lRank 'プレイスマークを設定 Set PlacemarkElement = AddElement(XmlDoc, DocumentElement, "Placemark") Set tmpElement = AddElement(XmlDoc, PlacemarkElement, "name", "") 'アイコンの横に名前を表示しない Set LookAtElement = AddElement(XmlDoc, PlacemarkElement, "LookAt") Set tmpElement = AddElement(XmlDoc, LookAtElement, "longitude", CStr(lng)) Set tmpElement = AddElement(XmlDoc, LookAtElement, "latitude", CStr(lat)) Set tmpElement = AddElement(XmlDoc, LookAtElement, "altitude", "0") Set tmpElement = AddElement(XmlDoc, LookAtElement, "heading", "1") Set tmpElement = AddElement(XmlDoc, LookAtElement, "range", "500") Set tmpElement = AddElement(XmlDoc, LookAtElement, "gx:altitudeMode", "relativeToSeaFloor") Set tmpElement = AddElement(XmlDoc, PlacemarkElement, "description", Desc) Set tmpElement = AddElement(XmlDoc, PlacemarkElement, "styleUrl", sRank) Set PointElement = AddElement(XmlDoc, PlacemarkElement, "Point") Set tmpElement = AddElement(XmlDoc, PointElement, "coordinates", lng_lat) Next Bridge End With 'テンポラリフォルダを作成 If Dir("C:\Temp", vbDirectory) = "" Then MkDir "C:\Temp" 'テンポラリフォルダにXMLを書き出し(拡張子はkml) XmlDoc.Save ("C:\Temp\Temp.kml") '作成したkmlを開く(要Google Earthのインストール) Dim WSH Set WSH = CreateObject("Wscript.Shell") WSH.Run "C:\Temp\Temp.kml", 3 Set lst = Nothing Set XmlDoc = Nothing Set xmlPI = Nothing Set RootNode = Nothing Set DocumentElement = Nothing Set StyleElement = Nothing Set PairElement = Nothing Set IconStyleElement = Nothing Set IconElement = Nothing Set PlacemarkElement = Nothing Set PointElement = Nothing Set LookAtElement = Nothing Set tmpElement = Nothing Set WSH = Nothing End Sub |
何が起こっているか
上で作成したプロシージャの主要部分を説明します。
テーブルの設定
6 7 |
Dim lst As ListObject Set lst = ThisWorkbook.Worksheets("Sheet1").ListObjects("テーブル1") |
対象とするテーブルをオブジェクト変数にセットします。下図のように ‘Sheet1’ 上に ‘テーブル1’ を作成しているのでこのようにします。
XMLファイル作成の準備
9 10 11 |
'XMLファイルを作成 要参照設定 Microdoft XML, v6.0 Dim XmlDoc As MSXML2.DOMDocument60 Set XmlDoc = New MSXML2.DOMDocument60 |
xmlDocというオブジェクト変数に新しいXMLドキュメントを作成してセットします。このためにはXMLの参照設定が必要です。
XMLの書き出し
13 14 15 |
'XML宣言を設定 Dim xmlPI As MSXML2.IXMLDOMProcessingInstruction Set xmlPI = XmlDoc.appendChild(XmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")) |
これにより、kmlファイル(実態はXMLファイル)の最初の部分(XMLの宣言)が作成されます。
1 |
<?xml version="1.0" encoding="UTF-8"?> |
kmlファイルの中身の作成
まず作成するxmlに、kmlというルートノードを追加します。
以下の部分で、
17 18 19 20 |
'kmlルートノードを設定 Dim RootNode As MSXML2.IXMLDOMElement Set RootNode = XmlDoc.createElement("kml") Set XmlDoc.DocumentElement = RootNode |
xmlはこのようになります。
1 2 3 |
<?xml version="1.0" encoding="UTF-8"?> <kml> </kml> |
次に、必要な要素を追加していきます。
22 23 24 25 26 |
'kmlドキュメント設定 Dim DocumentElement As MSXML2.IXMLDOMElement Dim tmpElement As MSXML2.IXMLDOMElement Set DocumentElement = AddElement(XmlDoc, RootNode, "Document") Set tmpElement = AddElement(XmlDoc, DocumentElement, "name", "Temporary") |
kmlルートノードの中に、Document要素を追加し、そのDocument要素にさらにname要素を追加し、Temporaryというテキストを追加します。
これにより、xmlの中身は以下のようになります。
1 2 3 4 5 6 |
<?xml version="1.0" encoding="UTF-8"?> <kml> <Document> <name>Temporary</name> </Document> </kml> |
以下、このような作業の繰り返しです。
- 35〜57行:赤、緑、黄のプッシュピンのスタイルを作成
- 71〜107行のループ:オートフィルタによって見えている行に対するループ
- 75〜80行:プロットする橋梁名、緯度経度、ランクなどを取得
- 83〜87行:ランクに応じて使用するスタイルを選定
- 90行:ポップアップする説明文を作成
- 93行〜105行:プレイスマークに必要なxmlを作成
93〜105行の部分で以下のようなxmlが作成されます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
<Placemark> <name></name> <LookAt> <longitude>141.46667</longitude> <latitude>40.32500</latitude> <altitude>0</altitude> <heading>1</heading> <range>500</range> <gx:altitudeMode>relativeToSeaFloor</gx:altitudeMode> </LookAt> <Description>橋梁名:○○橋1<br/>ランク2</Description> <styleUrl>#msn_ylw-pushpin</styleUrl> <Point> <coordinates>141.46667,40.32500,0</coordinates> </Point> </Placemark> |
kmlの各要素はリファレンスに説明があります。
ループが終わった後は、ソースコードのコメント欄にあるとおり、テンポラリフォルダを作成して、作成したxml文書をkmlファイルとして保存し、そのkmlファイルを起動し、Google Earthを立ち上げています。
おわりに
実行結果
作成したマクロを実行すると,XMLファイルが一時的に作成・起動され,Google Earth上に表示されます。
場所(プレイスマーク)パネルの各ポイントをクリックすると,その橋梁の位置へジャンプし,吹き出しに情報を表示させることが出来ます。
応用
今回はプレイスマークの例を挙げましたが、ライン要素に応用すれば、舗装の路面性状調査結果をプロットすることなども可能です。kmlの構造を読み解いて、是非チャレンジしてみてください。
ダウンロード
本エントリで作成した、「Excelのデータを用いてGoogle Earthにプレイスマークをプロット」するコードのサンプルファイルです。
本エントリからコピー&ペーストしてご自身で作成することが可能ですが、面倒な方、やり方がわからない方はこちらをダウンロード下さい。
※ここにGumroadのウィジェットを表示していますが、企業・学校などでフィルタリングにより表示されない場合があります。