もぐら王国 Excel VBA関連

ちょっと前に「エクセルのセルから右クリックでWeb検索等が出来たらいいのになぁ…(´･ω･｀)」と思い調べてちょこちょこ触ったものの、途中で他のことをやってしまったのか、その結末自体を忘れてしまっていた(ﾉ∀`)

ちなみにExcel2019ではスマート検索が使えるのでBingでの検索結果を表示することは出来る。模索していたのはGoogle検索を始めとするその他のWebサービスの利用。

残っていたリンクを読み直して、改めてちょろちょろと書いてみた。

Option Explicit

Sub ActiveCell_WEBSearch(strURL As String)

    Dim rgActiveCell As Range
    Set rgActiveCell = ActiveCell

    ActiveWorkbook.FollowHyperlink Address:=strURL & WorksheetFunction.EncodeURL(rgActiveCell)
End Sub

Sub Add_CommandBars_Proc()
    
    Dim cmdBar_google As CommandBarControl
    Dim cmdBar_weblio As CommandBarControl

    CommandBars("Cell").Reset

    SetCommandBars cmdBar_google, "Google検索", """https://www.google.co.jp/search?q="""
    SetCommandBars cmdBar_weblio, "Weblio検索", """https://www.weblio.jp/content?query="""

End Sub

Sub SetCommandBars(cmdBar As CommandBarControl, captionName As String, targetURL As String)
    Set cmdBar = CommandBars("Cell").Controls.Add()
    cmdBar.Caption = captionName
    cmdBar.OnAction = "ActiveCell_WEBSearch(" & targetURL & ")"

End Sub

参考：
【ブラウザ操作】簡単！5行VBA！セルの文字をGoogle検索するマクロ
 ショートカットメニュー（CommandBar オブジェクト）
ワークシート関数をVBAで使用する(WorksheetFunctionプロパティ)

Add_CommandBars_Proc()を一回だけ起動して、セルのコンテキストメニューにアクションを追加するだけ。

SetCommandBars()はAdd_CommandBars_Proc()でのアクション追加の重複部分を外に出しただけ。

Sub ActiveCell_WEBSearch()は実際の検索呼び出し部分で与えられたURLとアクティブセル内のテキストをパーセントエンコードして結合してActiveWorkbook.FollowHyperlinkに渡しているだけ。

でまあ、これはこれで動くのだけれども…
　
　
　
　
　
　
何故かタブが2つ開いてしまうヽ(`Д´)ﾉ

どうも2回呼び出されてるようだが、これを回避する方法がわからない。
NewWindow=Trueにしても関係ないし、ブラウザを日頃使ってるvivaldiからedgeに変更しても、IEに変更しても、chromeに変更しても症状は変わらない。つーか、ActiveCell_WEBSearch()内でMsgBoxを表示させてみたら2回表示されたので、2回呼ばれてるということなのだろう…

似たようなことでハマってる人居ないかなぁと思ったけれど、そんなに居なかった模様。うちの環境やコードがおかしいのか、それともこんな変なことをする人は少ないということなのだろうか？

一応stackoverflowでヒットしたけれども解決してない模様。
Private Sub Opens Hyperlink Twice instead of Once

バグなのか、仕様なのか？

2つタブが開くということにイライラしない人ならば、上記のようなコードで色々と出来ていいんだろうけれども、俺氏はちょっと耐えられない（＃＾ω＾）

まあ取り敢えずここまでまとめておけば、またいつか続きをする時に楽する為用のエントリ(ﾉ∀`) ﾀﾞｶﾗｵﾁﾊﾅｲ

カテゴリー: Excel VBA関連