先日の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 メソッドは重要な役割をします。
マクロ
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
