0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

ExcelVBA kmlファイルを作る(線のみ)

Posted at

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ファイルの方がわかりやすい気がします。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?