ContextSearch for MS-Word

Pocket

ワードで選択した文字列を各種検索エンジンで検索するためのマクロです。インストールすると右クリックメニューに「Context Search」が追加され、自分で登録・編集した複数の検索エンジンを使って検索することが可能となります。

context search

このマクロの目的

ワードを使って文書を編集している時、「この場合は『挙げる』だろうか、それとも『上げる』だろうか、ちょっと調べてみよう」ということがよくあります。そこで、オンライン辞書などで調べようとするのですが、そのためには「ワードで文字列を選択し、右クリックしてメニューからコピーを選択し、ブラウザを立ち上げ、ブックマークからサイトを選択し、当該サイトの検索窓にコピーした文字列を貼り付ける」というステップを踏む必要があります。1~2回なら我慢できますが、これを繰り返していると小さなストレスが積もっていきます。

この「ContextSearch」というマクロは、上記の煩雑なステップを「文字列選択、右クリック、検索」に短縮し、作業の省力化を図ることを目的にしています。文書作成時のイライラが少しだけ収まると思います。

インストールとアンインストール

インストールに先立ち、ワードは閉じておいて下さい。
まず、下記のリンクから圧縮ファイルをダウンロードします。

ダウンロード:contextsearch.zip

ダウンロードしたファイルを解凍すると、「contextsearch.dotm」と「url.csv」の2つのファイルが出てきます。この2つのファイルを下記のフォルダにコピー+貼り付けします。

C:\Users\ユーザー名\AppData\Roaming\Microsoft\Word\STARTUP

※「ユーザー名」の部分に自分のユーザー名が入ります。エクスプローラーでフォルダを開く場合、Cドライブ→Users→ユーザー名→AppData→Roaming→Microsoft→Word→STARTUPの順にフォルダをたどっていきます(Windows 10、Office 2016の環境)。

ワードを起動します。適当なファイルを開いて文字列を選択し、右クリックすると表示されるメニューに「Context Search」が追加され、上掲の図のように検索エンジンの一覧が表示されます。検索エンジンを選ぶとブラウザが立ち上がり、WEBサイトで検索結果が表示されます。

※「contextsearch.dotm」と「url.csv」は必ず上記フォルダに一緒に置いて下さい。

アンインストールの際は、ワードを閉じてから上記2ファイルをスタートアップフォルダから削除します。

検索エンジンの追加・編集

検索エンジンは、ユーザーが自由に登録できます。
「url.csv」をメモ帳などのテキストエディタで開いて下さい。文字コードはシフトJISです。
検索エンジン名〈タブ〉サイトのURL〈改行〉の形式でデータが登録されています。
タブ区切りのファイルですが、エクセルなどで開いて編集すると正しく動作しなくなりますのでご注意下さい。

例:
Google〈タブ〉http://www.google.com/search?q=%s

検索エンジンは上記のように登録されています。URL中の「%s」がワードで選択した文字列に置き換えられ、検索が実行されます。

なお、「url.csv」を開くと先頭に「#」が付いている行があります。これはコメント行でファイル読み込みの際には無視されます。

検索エンジンの登録例

以下に当方が登録しているサイト群を例として示します。ご参照下さい。

Google http://www.google.com/search?q=%s
北辞郎 http://www.ctrans.org/search.php?word=%s
英辞郎 http://eow.alc.co.jp/sp/search.html?q=%s&pg=1
Google-cn https://www.google.com/search?num=50&lr=lang_zh-CN&hl=zh-CN&q=%s
Google-tw https://www.google.com/search?num=50&lr=lang_zh-TW&hl=zh-TW&q=%s
Youdao http://dict.youdao.com/search?q=%s
dict.cn http://dict.cn/%s
iCiba http://www.iciba.com/%s
漢典 http://www.zdic.net/search/?q=%s
Wikipedia https://ja.wikipedia.org/wiki/%s
コトバンク http://dic.search.yahoo.co.jp/search?ei=UTF-8&fr=kb&p=%s&dic_id=all&stype=full
Weblio類語辞典 http://thesaurus.weblio.jp/content/%s
百度 http://www.baidu.com/s?wd=%s
Bing http://www.bing.com/search?q=%s
Yahoo! http://search.yahoo.com/search?vc=&p=%s

免責

このマクロはWindows 10、Office 2016の環境で動作を確認しています。そのほかの環境での動作は保証しません。
また、このマクロの使用に伴ういかなる損失についても作者は責を負いません。

ソース

マクロのソースは下記の通りです。ライセンスはBSDとします。

Dim SearchEngines As New Scripting.Dictionary

Sub AutoExec()
    On Error GoTo AutoExec_Error
    Dim MyMenu As Object
    Dim MainMenu As Object
    Dim SubMenu As Object
    
    'いったん削除
    Set MyMenu = Application.CommandBars("text")
    'MyMenu.Controls("Context Search").Delete
    'Ver1.1にて以下に変更
    MyMenu.Reset
    
    '検索エンジンのデータを取得
    If GetInitData() = False Then
        MsgBox "検索エンジンデータの取得に失敗しました", vbOKOnly, "Context Search"
        Exit Sub
    End If
    
    'メニューに登録
    Set MainMenu = MyMenu.Controls.Add(Type:=msoControlPopup)
    With MainMenu
        .Caption = "Context Search"
        .BeginGroup = True
    End With

    'サブメニューを構築
     For i = 0 To SearchEngines.Count - 1
        Set SubMenu = MainMenu.Controls.Add()
        With SubMenu
            .Caption = SearchEngines.Keys(i)
            .OnAction = "ContextSearch"
        End With
    Next i
    
    'todo:表部分の選択文字列への対応 With Application.CommandBars("table text") End With
    
    On Error GoTo 0
    Exit Sub

AutoExec_Error:
        If Err = 5 Then
            Resume Next
        Else
            MsgBox "エラーが発生しました", vbOKOnly, "Context Search"
        End If
End Sub

Sub AutoExit()
    On Error GoTo AutoExit_Error
    With Application.CommandBars("text")
        .Controls("Context Search").Delete
    End With
    On Error GoTo 0
    Exit Sub

AutoExit_Error:
        If Err = 5 Then
            Resume Next
        Else
            MsgBox "エラーが発生しました。", vbOKOnly, "Context Search"
        End If
End Sub

Sub ContextSearch()
    Dim target As String
    Dim url As String
    target = Selection
    If target = "" Then
        Exit Sub
    End If
    For i = 0 To SearchEngines.Count - 1
        If SearchEngines.Keys(i) = Application.CommandBars.ActionControl.Caption Then
            url = Replace(SearchEngines.Items(i), "%s", target)
            url = Replace(url, " ", "+")
            url = Replace(url, " ", "+")
            Exit For
        End If
    Next i
    ActiveDocument.FollowHyperlink Address:=url
End Sub

Function GetInitData() As Boolean
    Dim buf As String
    Dim path As String
    Dim tmp As Variant
    Dim FileNo As Integer
    path = Application.StartupPath & "/url.csv"
    If Dir(path) = "" Then
        GetInitData = False
        Exit Function
    End If
    FileNo = FreeFile()
    Open path For Input As #FileNo
    On Error Resume Next
    Do Until EOF(FileNo)
        Line Input #FileNo, buf
        'コメント行は無視
        If Left(buf, 1) <> "#" Then
            tmp = Split(buf, vbTab)
            '検索エンジン名+URLでなければ無視
            If UBound(tmp) = 1 Then
                SearchEngines.Add tmp(0), tmp(1)
            End If
        End If
    Loop
    Close #FileNo
    GetInitData = True
End Function

更新情報

2024/09/03 Version 1.1 コンテキストメニューの初期化方法を変更(→MyMenu.Reset)

2件のコメント

  1. Windows 10+Word 2013+メインブラウザChrome、の環境で自己責任で導入してみました。
    Googleが時折、百度がごくまれにブラウザに飛んだ時に文字化け(たいてい欧文フォント。漢字で化ける時もあります)するものの、Wordから汉典や北辞郎を楽に引くことができるようになり、大変満足です。いいものを作成いただき、ありがとうございます! \(^▽^)/
    なお、文字化けの法則(どんなことをどんな状態や環境でやると化けるのか)については判明していません……。

    1. 早速お試しいただき、ありがとうございます!
      文字化けの件、手元の環境でも確認したいと思います。法則が見つかり、対応できそうでしたら、ご報告させていただきますm(_ _)m

コメントする

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください