geojsonがメインでkmlがおまけ
C3くらいにファイル名
W09122201-mati-185-2.geojson
のように記述します
B6とC6から緯度 経度が始まり、
最後はB6 C6の値が入ってとじられれます。
規格
文字コードはUTF-8らしい
改行がLFらしい
BOMはないらしい(あっても動いた)
BOMの除去はこちらを参考にしました。
https://qiita.com/kou_tana77/items/66b14c7649792c9703d8
一応国土地理院とGoogle Earthの両方で描画されます。
線のみで塗りつぶしはありません。
注意点
ファイル名
Excelファイルが保存されていることを前提としており、保存フォルダにファイルが生成されます。
同じフォルダ内に同名のkmlファイルがある場合、上書きではなく削除されます。1ファイルごとに必ずファイル名を変更してください。
ファイル名は半角英数字の使用を推奨します。
kmlファイルの注意点
KMLタグの大文字・小文字は厳密に区別されるため、誤ると動作しません。
小数点以下は6桁程度、それ以上になると誤差であまり意味がないとされていますが、8桁で誤差がmm単位なので、8桁が上限でしょう。Excelの有効桁数が15桁なので、最大で11桁程度使います。
緯度、経度は半角スペース (chr(32)) で区切っていますが、改行でも区切ることができます。
<coordinates>
139.6917,35.6895
139.7000,35.6900
</coordinates>
<coordinates>
139.6917,35.6895 139.7000,35.6900
</coordinates>
高度(Z座標)を省略しているのでデフォルトの高度(0または地表面)に描かれます。
制約
ポリゴン(面)を作成する場合、より複雑なKMLタグ指定が必要になるため、今回は 緯度・経度の情報をもとに線(Polyline)のみを作成しています。
Google Earthおよび国土地理院の地図上で動作するように調整しましたが、仕様として完全に適合しているかは未確認です。
コード
Sub excel2kmlLine()
' Excel VBA
' 緯度 B6 ’ 経度 C6 から記述 最後の行は B6 C6 と同じにして閉じるようにする
' Filename C3 W09-12201-mati.geojson
' W 世界測地系 系番号 09 自治体コード 12201 東京都世田谷区 町名 番地
' Excel自体は保存されている
Dim k As Integer, LastRow As Long, i As Long
Dim xData As Double, yData As Double, geojsonFilename As String, strBuf As String, fStr As String
Dim buf As Variant
Const adTypeBinary = 1, adTypeText = 2, adLF = 10
Const startRow = 6
' 最終行の取得
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
'KML File Block
' 線のみで、塗りつぶしがない
' 拡張子変換
geojsonFilename = ActiveWorkbook.Path & "\" & Range("C3")
Debug.Print "geojsonfilename", geojsonFilename
geojsonFilename = Replace(geojsonFilename, ".geojson", ".kml", 1, -1, vbTextCompare)
Debug.Print "geojsonfilename2", geojsonFilename
' 重複削除
If Dir(geojsonFilename) <> "" Then Kill geojsonFilename
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Mode = 3
.Type = adTypeText
.LineSeparator = adLF
.Open
.WriteText "<?xml version=""1.0"" encoding=""UTF-8""?>", 1
.WriteText "<kml xmlns=""http://www.opengis.net/kml/2.2"">", 1
.WriteText "<Document>", 1
.WriteText "<Style id=""LineStyle1"">", 1
' 線の形状を指定その1
.WriteText " <LineStyle>", 1
.WriteText " <color>ffff8833</color>", 1
.WriteText " <width>3</width>", 1
.WriteText " </LineStyle>", 1
.WriteText "</Style>", 1
.WriteText "<Placemark>", 1
.WriteText "<name>" & Replace(ActiveSheet.Range("c3").Value, ".geojson", ".kml", 1, -1, vbTextCompare) & "</name>", 1
' 詳細欄(未試験、どの程度入るかは不明)
.WriteText "<description><![CDATA[ <table><tr><td>item-1</td><td></td></tr><tr><td>item-2</td><td></td></tr><tr><td>item-3</td><td></td></tr></table> ]]></description>", 1
' 線の形状を指定その2
.WriteText "<styleUrl>#LineStyle1</styleUrl>", 1
.WriteText "<LineString>", 1 ' linestrigのように大文字、小文字が違うとダメ。綴じるタグも完全に同じ
.WriteText "<coordinates>", 0
strBuf = ""
For i = startRow To LastRow
If i <> LastRow Then
strBuf = strBuf & Cells(i, 3).Value & "," & Cells(i, 2).Value & Chr(32)
Else
strBuf = strBuf & Cells(i, 3).Value & "," & Cells(i, 2).Value & "</coordinates>"
End If
Next i
.WriteText strBuf, 1
.WriteText "</LineString>", 1
.WriteText "</Placemark>", 1 ' タグは、大文字小文字も区別される markは小文字
.WriteText "</Document>", 1
.WriteText "</kml>"
' BOM の除去
' https://qiita.com/kou_tana77/items/66b14c7649792c9703d8
.Position = 0 ' 最初に戻す
.Type = adTypeBinary ' バイナリにする
.Position = 3 ' Bomをとばす
buf = .Read() ' 読み込む ReadAllではない
.Position = 0 '最初に戻す これを入れないと最後に記述する
.Write buf ' バイナリで書き込み
.SetEOS '後ろに残る分を消す
' 保存
.SaveToFile geojsonFilename, 1
.Close
End With
End Sub
資料
KMLウェブ地図プロファイル
みてもよくわからない…
個人的な意見ですが、geojsonファイルの方がわかりやすい気がします。