LibreOffice Calc Basic、Google マイマップに登録した場所を、 KMLファイル経由でワークシートに取り込むプログラム

2020年9月6日 15:44

Google Map のマイマップから書き出した KML ファイルを、LibreOffice Calc に取り込むプログラムを作った。

背景

野外で撮影した写真と撮影地を紐付けたい。
撮影地は、Google マイマップに「場所」として登録したもので、その場所の名前と緯度経度が含まれている。そのデータをワークシートに取り込んで利用する。また撮影環境によっては位置情報に大きな誤差が生じることがあるので、どこで撮影したかを思い出しながら、Google マップ上で「場所」を確認している。

位置情報は、Google マイマップ上とワークシート上に存在することになる。位置情報を更新する場合には、Google マイマップを修正する。そしてそのデータをワークシートに取り込むことにした。逆はやらない。

最初に、LibreOffice Calc からブラウザーで開いた地図にアクセスしてデータを取り込もうとした。しかし難しいプログラムになりそうだった。できる気がしなかった。そこで、データを一旦 KML ファイルにエクスポートして、それを LO Calc に取り込むことにした。

やっていること

KML ファイルから情報を読む。
タグを目印に、必要な情報を取り出す。
ワークシートに書き込む。

※ KML ファイルのエクスポートは、手作業。

学んだこと

LO Basic で正規表現を使う方法を学んだ。

別途これに関連した記事を書く。

使い方

「コードを追加した Calc ファイル」と「KML ファイル」を同じフォルダーに置き、プログラムを実行する。

新しく KML シートが作られ、A列に名前、B列に緯度経度が取り込まれる。

最初に見つかったKMLファイルだけを処理する。
すでに KML という名称のシートがある場合は、断りなく上書きする。

制作環境

Mac OS X El Capitan
LibreOffice 7.0.0.3

[参考] Google マイマップに場所を登録し、KML ファイルにエクスポートする

Google アカウントで Google マイマップにログインして、「マーカーを追加」アイコンをクリック、地図上をクリックすると場所（マーカー）が追加される。
メニューから、「KML / KMZ にエクスポート」を選択、選択肢を選んで、KML にエクスポートする。

[参考] Google マイマップ

[参考] KML 入門用ドキュメント | KML（Keyhole Markup Language ...

コード

REM  *****  BASIC  *****

Option Explicit

Sub Main
	
	Dim fname As String
	Dim MyString As String
	Dim FileNumber As Long
	Dim MyDocument As Object
	Dim MyPath As String
	Dim MyURL As String
	Dim MyFolder As String
	Dim MyKMLFile As String
	Dim MyKMLText As String
	Dim ExistingSheets As Object
	Dim KMLSheet As Object
	Dim MyRow As Long

	Dim TextSearchP As Object
	Dim TextSearchN As Object
	Dim TextSearchC As Object
	Dim SearchOptionsP As Object
	Dim SearchOptionsN As Object	
	Dim SearchOptionsC As Object
	Dim MyResult As Variant
	Dim MyPlacemark As String
	Dim MyName As String
	Dim MyCoordinates As String
	Dim SearchStart As Long
	
'＊＊＊＊＊＊　ワークシート関連　＊＊＊＊＊＊＊
'　このブック
	MyDocument =  ThisComponent

'　このブックが置かれている場所
	MyURL = MyDocument.getLocation()
	MyPath = ConvertFromURL(MyURL)
	
'　このブックが置かれているフォルダー
	MyFolder = Left(MyPath, Len(MyPath) - Len(MyDocument.getTitle()))
	
'　このブックと同じフォルダーで *.kml ファイルを探し、最初に見つかったファイルを処理する。
	MyKMLFile = Dir(MyFolder + "*.kml")
	If  MyKMLFile = "" Then
	'　同じフォルダーに *.kml ファイルがなかったらやめる。
		Exit Sub
	Else
	
'　KML ファイルのパスを設定　。
		fname = MyFolder + MyKMLFile
		
'　このブックに含まれるシートの集まり。
	ExistingSheets = MyDocument.getSheets()
	
'　このブックにKML シートがなかったら作る。
		If NOT ExistingSheets.hasByName("KML") Then
    		ExistingSheets.insertNewByName("KML", ExistingSheets.count)
    	End If
	End If

'　KML データ取り込み用シート
    KMLSheet = ExistingSheets.getByName("KML")
    
'　KML シートの全コンテンツ消去（書式以外をクリア）
	KMLSheet.clearContents(1 + 2 + 4 + 8 + 16)
	
'　※２行目以下を消しても良かったが、全消しの方が楽だったので、、、

'　見出しを１行目に書き込む
	KMLSheet.getCellRangeByName("A1").String = "名称"
	KMLSheet.getCellRangeByName("B1").String = "緯度経度"

'＊＊＊＊＊＊　KML ファイル読み込み　＊＊＊＊＊＊＊
	FileNumber = FreeFile()
   Open fname For Input As #FileNumber
'　ファイルの最後 EOF まで１行読んで変数に追加。
'　Chr(13) は CR、Chr(10) は LF
    Do While Not EOF(FileNumber)
        Line Input #FileNumber, MyString
        MyKMLText = MyKMLText & Chr(13) & Chr(10) & MyString
    Loop
'　KML ファイルを閉じる
    Close #FileNumber

'＊＊＊＊＊＊　正規表現関連の設定　＊＊＊＊＊＊＊
'　TextSearch をインスタンス化にあたり、タグ別に３つ用意した。
'　P=Placemark, N=name, C=coordinates

'　● Placemark タグで囲まれた文字列の抽出用オプションの設定
'　このタグで囲まれた範囲で、改行を含み、最短一致の条件
'　丸括弧で囲んだところはタグ以外の部分、インデックス指定で取り出し可能
'　TextSearch サービスのインスタンス化
	TextSearchP = CreateUnoService("com.sun.star.util.TextSearch")
	SearchOptionsP = CreateUnoStruct("com.sun.star.util.SearchOptions")
	SearchOptionsP.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
	SearchOptionsP.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED
	SearchOptionsP.searchString = "<Placemark>([\s\S]*?)</Placemark>"
	TextSearchP.setOptions(SearchOptionsP)
	
'　● name タグで囲まれた文字列の抽出用オプションの設定
'　このタグで囲まれた範囲で、改行を含み、最短一致の条件。
'　丸括弧で囲んだところはタグ以外の部分、インデックス指定で取り出し可能
	TextSearchN = CreateUnoService("com.sun.star.util.TextSearch")
	SearchOptionsN = CreateUnoStruct("com.sun.star.util.SearchOptions")
	SearchOptionsN.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
	SearchOptionsN.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED
	SearchOptionsN.searchString = "<name>([\s\S]*?)</name>"
'　name は、現物を見るとタグの間に文字しか存在しないが、
'	あまり意味もなく Placemark の設定と同じ形にした。
	TextSearchN.setOptions(SearchOptionsN)
	
'　● coordinates タグで囲まれた文字列の抽出用オプションの設定
'　このタグで囲まれた範囲で、改行を含み、最短一致の条件。
'　丸括弧で囲んだところはタグ以外の部分、改行を含む前後の文字を含まず経度緯度だけ
	TextSearchC = CreateUnoService("com.sun.star.util.TextSearch")
	SearchOptionsC = CreateUnoStruct("com.sun.star.util.SearchOptions")
	SearchOptionsC.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
	SearchOptionsC.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED
	SearchOptionsC.searchString = "<coordinates>[\s\t\n]*?(\S*?),(\S*?),[\s\S]*?</coordinates>"
'　データの形は「          139.2953434,35.441687,0」で、タグとの間に改行が入っている。
'	経度および緯度をそれぞれ丸括弧で囲みグループ化し、検索後に参照できるようにしている。
	TextSearchC.setOptions(SearchOptionsC)
'　Placemark タグの検索開始位置	
	SearchStart = 0
'　書き込み先の行
	MyRow = 2
	
'　検索開始位置を送りながら、Placemark タグの塊を拾っていく。

	Do while SearchStart < Len(MyKMLText)

'＊＊＊＊＊＊＊＊　<Placemark> 抽出　＊＊＊＊＊＊＊＊＊
		MyResult = TextSearchP.searchForward(MyKMLText, SearchStart, Len(MyKMLText))
'　Placemark タグがあったら処理を進める
		If MyResult.subRegExpressions = 2 then
'　Placemark タグの内側の文字列、１か所分のデータ
'　正規表現によるマッチ結果が、位置で返される。
'　元のテキストから位置と長さを指定して目的の文字列を抽出する。
			MyPlacemark = mid(MyKMLText, MyResult.startOffset(1) +1, MyResult.EndOffset(1) -MyResult.startOffset(1))
'　気が早いが、ここで次の検索位置を設定しておく
'　というか、MyResult 変数を使い回しているので、ここでやっておく
			SearchStart = MyResult.EndOffset(0) + 1
			
'ー＊＊＊＊＊＊＊＊　<name> 抽出　＊＊＊＊＊＊＊＊＊＊
'　Placemark データから、name タグに囲まれた文字列を抽出する。
			MyResult = TextSearchN.searchForward(MyPlacemark, 0, Len(MyPlacemark))
'　マッチするものがあったら処理して変数に入れる。
			If MyResult.subRegExpressions = 2 Then
				MyName = mid(MyPlacemark, MyResult.startOffset(1) +1, MyResult.EndOffset(1) -MyResult.startOffset(1) )
			Else
				MyName = ""
			End If
		
'ー＊＊＊＊＊＊＊　<coordinates> 抽出　＊＊＊＊＊＊＊＊＊
'　Placemark データから、coordinates タグに囲まれた文字列を抽出する。
			MyResult = TextSearchC.searchForward(MyPlacemark, 0, Len(MyPlacemark))
'　インデックス 1 が経度、インデックス 2 が緯度。入れ替えて緯度経度データとする。
			If MyResult.subRegExpressions = 3 Then
				MyCoordinates = mid(MyPlacemark, MyResult.startOffset(2) +1, MyResult.EndOffset(2) -MyResult.startOffset(2) ) & ","
				MyCoordinates = MyCoordinates & mid(MyPlacemark, MyResult.startOffset(1) +1, MyResult.EndOffset(1) -MyResult.startOffset(1) )
			Else
				MyCoordinates = ""
			End If
			
''ー＊＊＊＊＊＊＊　データの書き込み　＊＊＊＊＊＊＊＊＊		
			KMLSheet.getCellRangeByName("A" & MyRow).String = MyName
			KMLSheet.getCellRangeByName("B" & MyRow).String = MyCoordinates		

'　書き込む行を次の行に設定する。
			MyRow = MyRow + 1
		Else
			Exit Do
		End If	
	Loop
	
	MsgBox "終わりました。"
	
End Sub

整理されていない箇所もあるが、スマートに仕上げようという努力はした。

2020年8月にエクスポートしたデータに合わせて作った。
「KML 入門用ドキュメント」のページへのリンクをこの記事の上の方に貼り付けた。そのページにリファレンスへのリンクがある。

KML ファイルの coordinates は、次のように規定されている。

<coordinates>(required)
A single tuple consisting of floating point values for longitude, latitude, and altitude (in that order).

t.koba

この記事が気に入ったらサポートをしてみませんか？