【Word VBA】英辞郎 on the Web Pro で辞書検索するWordマクロ

2017年12月26日

, ,

先日のJTF翻訳セミナーで配布したマクロに、英辞郎 on the Web Pro で検索できるマクロを追加しました。

また、以前から、「【右クリックでGoogle！】串刺し検索用のコマンド例」にて、英辞郎 on the Web Pro で串刺し検索するための方法を紹介していました。

ところが、最近になって 英辞郎 on the Web Pro の仕様が変更になったらしく、毎回ログインを求められるようになってしまいました。

というわけで、いろいろと原因を探っていたところ、Internet Explorer から英辞郎にアクセスすると今まで通りログイン画面が表示されることなく検索結果を表示できることが分かりました。

マクロのコードを紹介します。JTFマクロ集への反映は少しお待ちください。

このマクロでできること

文字列を選択してマクロを実行すると、選択した文字列を 英辞郎 on the Web Pro で検索して結果を表示します。

マクロの解説

最近は、VBAでInternet Explorerを操作する方法についての情報が豊富にウェブに出ています。

書籍では、以下の「Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応」がおすすめです。

こういう情報を組み合わせて作りました。

あと、URLをエンコードするための仕組みは、Microsoft MVP のきぬあささんの「64ビット環境でのScriptControlの代わり」を使わせていただきました。

検索のたびにタブが増えてしまい不快に感じている方は、41行目と42行目をコメントにして（行頭に ' を追加）、44行目と45行目のコメントを解除（行頭の ' を削除）してください。

45行目の処理を実行する場合、新しいタブを開かず一番左側のタブに検索結果を表示するようになります。

12行目の処理で、選択範囲の末尾に改行記号が含まれている場合に除外します。文字列を正確に選択するときに MoveEndWhile メソッドは重要な役割をします。

MoveEndWhile メソッド を使ったサンプルコード

マクロ


Sub 英辞郎_on_the_Web_Pro()
 
  Dim objIE As Object
  Dim objShell  As Object
  Dim objWin As Object
  Dim URL As String
  Dim myKeyword As String
  
  If Selection.Type = wdSelectionIP Then
    myKeyword = ""
  Else
    Selection.MoveEndWhile Cset:=Chr(13), Count:=wdBackward
    myKeyword = Selection.Text
  End If
 
  URL = "https://eowp.alc.co.jp/search?q=" & EncodeURL(myKeyword)
 
  '-------------------------------------------
  'IE起動
  '-------------------------------------------
  'Shellオブジェクトを作成する
  Set objShell = CreateObject("Shell.Application")
   
  '現在IEが開いている場合には、そのIEをobjIEに設定
  For Each objWin In objShell.Windows
    If objWin.Name = "Internet Explorer" Then
      Set objIE = objWin
      Exit For
    End If
  Next

  '現在IEが開いていない場合には、新しくIEを開きobjIEに設定
  If objIE Is Nothing Then
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True
  End If
  
  '-------------------------------------------
  '検索実行
  '-------------------------------------------
  '新しいタブに検索結果を表示する場合
  objIE.navigate2 URL, &H800
  
'  'タブ1に検索結果を表示する場合
'  objIE.navigate URL
  
  Set objIE = Nothing
  Set objShell = Nothing
  
End Sub

Private Function EncodeURL(ByVal sWord As String) As String
  
  'きぬあささんのコード(64ビット対策)
  'https://www.ka-net.org/office/of32.html
  
  Dim d As Object
  Dim elm As Object
  
  sWord = Replace(sWord, "\", "\\")
  sWord = Replace(sWord, "'", "\'")
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & sWord & "');", "JScript"
  EncodeURL = elm.innerText
  
End Function

-コード
-, ,