Excel VBA 国土地理院地図のgeojsonから緯度と経度を取得する

国土地理院地図のツール

このように手書きで図形が書けます。これをgeojsonで出力します。
手書きなので測量図のような精度はありませんが、一度記録すると再び読み込ませて表示することができるため、大変便利です。
https://maps.gsi.go.jp/#5/36.104611/140.084556/&

Geojsonから読み込む

書き出すのは多いけど、読み込むのはないので。
あと、あまり多段になっているのは自信ないです。
シンプルなものだけですね。

参照設定

Adodb.Stream

Geojsonはutf-8、改行コードがLfということなのでAdodb.streamを使います

VBScript.RegExp

ここでいうgeojsonファイルは多角形のPolygonです。
中身を見ると、
スペース 経度 コンマ LF スペース　緯度
となっているので、これを切って抜いていきます。
Qiitaでは ¥ は \で表示されています。
取得できない(0)場合はエラーで終了します。
また、geojsonファイルはC:\hoge\hoge.gejsonにあるとしています。
ワークシートはActiveではなく、新たに追加する形にしています。
連打するとワークシートが増えるので注意してください。

Sub Macro1()
Dim sr As New ADODB.Stream
Dim sbuf As String
Dim FSO As New Scripting.FileSystemObject, oFile As File, ofolder As Folder, sPath As String, sFilename As String, sfullname As String
Dim Reg As New RegExp, MC As MatchCollection, M As Match, sBMs As SubMatches, iM As Long, rBuf As String
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets.Add
Dim irow As Long, icol As Long
sfullname = "C:\hoge\hoge.geojson"
With sr
.Mode = adModeReadWrite
.LineSeparator = adLF
.Charset = "utf-8"
.Type = adTypeText
.Open
.LoadFromFile sfullname
sbuf = .ReadText(adReadAll)
End With
With Reg
.Global = True
.MultiLine = True
.Pattern = "(\s+)([\d]{1,3}\.[\d]{1,})(,\n)(\s+)([\d]{1,3}\.[\d]{1,})"
Set MC = .Execute(sbuf)
If MC.Count = 0 Then
MsgBox "エラー、座標を取得できません", vbCritical + vbOKOnly, "終了"
sr.Close
Exit Sub
End If
ws.Cells(1, 1) = "緯度"
ws.Cells(1, 2) = "経度"
For iM = 0 To MC.Count - 1
Set M = MC(iM)
Debug.Print M.Value
ws.Cells(iM + 2, 1) = M.SubMatches(4) '緯度
ws.Cells(iM + 2, 2) = M.SubMatches(1) '経度
Next
End With
sr.Close
End Sub

VBAの正規表現の改行

改行は\nですが、ファイルの改行コードがLFでもCrLFでも改行判定しているようです。