地理院地図でkmlを使わずにExcelデータから複数のマーカーをプロット(2)

1 Excelで位置情報のデータを整理
2 地図をコントロールするプロシージャ
3 実行結果
4 ダウンロード

Excelで位置情報のデータを整理

前回のページで複数のマーカーをプロットするための地理院地図のHTML,Javascriptを用意しました。
ここでは例として、全国の都道府県の県庁所在地をプロットしてみます。

都道府県の位置情報を調べてデータを作成します。いろいろな方法が考えられますが、ここではデータ範囲が明示的なテーブル定義を行います。図のようにワークシート名を「都道府県」テーブル名も「都道府県」と設定して、カラムは都道府県番号「#」、「都道府県名」、「緯度」、「経度」を用意してデータを整理します。

地図をコントロールするプロシージャ

標準モジュールに以下のコードを追加します。

Option Explicit

Public Sub putMarkers()

[crayon-5d7f873f1dbaf338329766 ]<code>Dim ie As InternetExplorer
Dim HR As Long
Dim id As Variant
Dim R As Long
Dim lon As Double
Dim lat As Double
Dim Description As String

'IEのインスタンスを生成
Set ie = CreateObject("InternetExplorer.Application")

'IEで地理院地図の準備
With ie

    '用意したHTMLのアドレスを開く
    .Navigate "http://xl.hisholy.net/putMarkers/putMarkers.html"
    .Visible = True

    'IEの表示待ち
    Do While .Busy Or .ReadyState &lt; READYSTATE_COMPLETE
        DoEvents
    Loop

End With

'リスト内のデータ処理
With ThisWorkbook.Worksheets("都道府県").ListObjects("都道府県")

    'テーブルヘッダの行番号
    HR = .HeaderRowRange.Row

    'テーブルの見えている行に対するループ
    For Each id In .ListColumns("#").DataBodyRange.SpecialCells(xlCellTypeVisible)


        R = id.Row - HR 'テーブル内の行番号
        lon = .ListColumns("経度").DataBodyRange(R).Value '該当行の経度を取得
        lat = .ListColumns("緯度").DataBodyRange(R).Value '該当行の緯度を取得

        'マーカーを配置するスクリプトを実行
        ie.Document.parentWindow.execScript ("putMarkers(" _
            &amp; lon &amp; "," &amp; lat &amp; _
            ",'http://xl.hisholy.net/putMarkers/" &amp; id.Value &amp; ".png')")

        '下段の説明用文字列を作成
        Description = Description &amp; id.Value &amp; ":" &amp; _
            .ListColumns("都道府県名").DataBodyRange(R) &amp; _
            "，経度 " &amp; lon &amp; "，経度 " &amp; lat &amp; "&lt;br/&gt;"
    Next

    'HTMLに説明分を追加
    ie.Document.getelementbyid("description").innerHTML = Description

End With

Option Explicit

Public Sub putMarkers()

[crayon-5d7f873f1dbaf338329766 ]<code>Dim ie As InternetExplorer

Dim HR As Long

Dim id As Variant

Dim R As Long

Dim lon As Double

Dim lat As Double

Dim Description As String

'IEのインスタンスを生成

Set ie = CreateObject("InternetExplorer.Application")

'IEで地理院地図の準備

With ie

'用意したHTMLのアドレスを開く

.Navigate "http://xl.hisholy.net/putMarkers/putMarkers.html"

.Visible = True

'IEの表示待ち

Do While .Busy Or .ReadyState < READYSTATE_COMPLETE

DoEvents

Loop

End With

'リスト内のデータ処理

With ThisWorkbook.Worksheets("都道府県").ListObjects("都道府県")

'テーブルヘッダの行番号

HR = .HeaderRowRange.Row

'テーブルの見えている行に対するループ

For Each id In .ListColumns("#").DataBodyRange.SpecialCells(xlCellTypeVisible)

R = id.Row - HR 'テーブル内の行番号

lon = .ListColumns("経度").DataBodyRange(R).Value '該当行の経度を取得

lat = .ListColumns("緯度").DataBodyRange(R).Value '該当行の緯度を取得

'マーカーを配置するスクリプトを実行

ie.Document.parentWindow.execScript ("putMarkers(" _

& lon & "," & lat & _

",'http://xl.hisholy.net/putMarkers/" & id.Value & ".png')")

'下段の説明用文字列を作成

Description = Description & id.Value & ":" & _

.ListColumns("都道府県名").DataBodyRange(R) & _

"，経度 " & lon & "，経度 " & lat & "<br/>"

'HTMLに説明分を追加

ie.Document.getelementbyid("description").innerHTML = Description

End With

End Sub
[/crayon]

5,14行目　IEオブジェクトを生成

ExcelでIEをコントロールできるように、インスタンスを生成し、オブジェクト変数にセットします。
そのために、Microsoft Internet Controls の参照設定が必要になります。

17〜28行目　IEで地理院地図の準備

17〜28行目のWithブロック内は ieオブジェクトへの処理をまとめたものです。
20〜21行目：前回作成したhtmlファイルのURLでIEを起動し、表示させます。
24〜26行目：IEの表示が完了するまで待ちます。

31〜58行目　リスト内のデータを処理

17〜28行目のWithブロック内はリスト内のデータ処理をまとめたものです。
34行目：テーブルのヘッダ行のワークシートにおける行番号を取得しています。
37〜58行のFor Eachは、テーブル内のカラム”#”の見えている行に対してループします。
オートフィルタを使って非表示になった行は処理されません。
40行目：対象のテーブル内における行番号を取得します。
41〜42行目：その行番号の経度、緯度のカラムの値を取得します。
45〜47行目：前回作成したJavascriptの関数 putMarkersを実行しています。引数は上の行で取得した経度、緯度とアイコンの画像ファイルのアドレスを順に指定しています。画像は開発段階でボツにしたものですが、以下のような1〜47のピンを用意しました。