最近のトラックバック

2018年10月
  1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31      
無料ブログはココログ

« @アニメ(2018夏アニメOP、ED) | トップページ | ◆Excel VBA(【IE操作】Google mapの位置情報(緯度、経度)から2点間の距離を求めるマクロ) »

2018年8月 7日 (火)

◆Excel VBA(【IE操作】Google mapのルートを逆転させるマクロ)

今回は久しぶりのExcel VBAネタです。
前々から思っていたのですが、Google mapでルートを作成して、出来上がったルートを逆ルートで走行したくなることはありません?経由地が最大10カ所設定できるgoogle mapのルートを手で入れ替えするのが面倒くさい。一発で逆ルートにできる機能はないかなと。

普段は作成したルートを短縮URLにしてExcelで管理しているのですが、短縮URLを開くとオリジナルの長いURL(以下オリジナルURLと表記します)で表示されますね。そのURLを観察すると、経由地(緯度、経度や名称)が/(スラッシュ)で区切られている。このオリジナルURLから経由地を取り出して、逆順に入れ替えてgoogle mapのURLを再生成するVBAを作ればよいのではと考えました。一発とは言えませんが作業の流れは以下の通りです。

(1)Excel上で管理している短縮URLをクリックし、IEでルート表示する。

(2)表示されているオリジナルURLをコピーします。

(3)Excel上にあらかじめ用意したメモにペーストします。
最初、セル内にペーストしたのですがURLが長くなると切れてしまったからです。

(4)マクロを実行して、新たなメモに逆転したルートのURLを生成します。

(5)生成したURLをIEに貼り付けて逆転したルートを表示します。
必要に応じて短縮URLにする。

多少手間ですが、目的の逆転ルートのURLはできました。
興味があればソースを参考にしてみてください。

※2018/8/10追記
下記ソースのmod startからmod endまで修正しました。
実は前々から懸案だったのですが、高速道路を使用するかしないかのオプション情報が欠落してしまう問題があったのですが、まだ中途半端ですがとりあえずその問題を修正しました。内容に興味がある方はネットで”google map URL data=”などで検索してみてくださいね。



Sub ルート逆転()
    Dim lUrl_A As String
    Dim lUrl_B As String
    Dim lUrl_C As String
    Dim lUrl_NEW As String
   
    If Cells(ActiveCell.Row, ActiveCell.Column).Comment Is Nothing Then GoTo p_end
    lUrl = ActiveCell.Comment.text

    'オリジナルURLを分解
    lUrl = Mid(lUrl, InStr(lUrl, "dir/") + 4)
    lUrl_A = Mid(lUrl, 1, InStrRev(lUrl, "@") - 2)
    lUrl_B = Mid(lUrl, InStrRev(lUrl, "@"))
   
    larr = Split(lUrl_A, "/")
   
    'URL逆転
    lUrl_NEW = ""
    For i = UBound(larr) To 0 Step -1
        lUrl_C = lUrl_C & "/" & larr(i)
    Next
'mod start-------------
    If lUrl Like "*2m1!1b1!3e0" Then
        lUrl_NEW = "https://www.google.co.jp/maps/dir" & lUrl_C & "/data=!4m3!4m2!2m1!1b1"    '高速道路を使用しない
    Else
        lUrl_NEW = "https://www.google.co.jp/maps/dir" & lUrl_C
    End If
'mod end-------------
   
    'コメントに抽出(コメント操作の遊びあり)
    With Cells(ActiveCell.Row + 1, ActiveCell.Column)
        On Error Resume Next
        .ClearComments
        On Error GoTo 0
        .AddComment
        .Comment.Visible = True
        .Comment.text text:=lUrl_NEW
        .Comment.Shape.Width = 600
        .Comment.Shape.Height = 150
        .Comment.Shape.DrawingObject.Interior.ColorIndex = 35
        .Comment.Shape.DrawingObject.Font.Size = 8
        .Comment.Shape.DrawingObject.Font.Bold = True
       
    End With
p_end:
   
End Sub


<シート側>
Photo_2

<Google Map 正ルート>
A_2

<Google Map 逆ルート>
B_2

« @アニメ(2018夏アニメOP、ED) | トップページ | ◆Excel VBA(【IE操作】Google mapの位置情報(緯度、経度)から2点間の距離を求めるマクロ) »

パソコン・インターネット」カテゴリの記事

コメント

コメントを書く

(ウェブ上には掲載しません)

« @アニメ(2018夏アニメOP、ED) | トップページ | ◆Excel VBA(【IE操作】Google mapの位置情報(緯度、経度)から2点間の距離を求めるマクロ) »