※ 2016/2 時点では下記の方法はもう使用できなくなっています。VBAからGoogle翻訳を利用する場合は有償のTranslate APIをお使いください。
2016/2/18 追記:
Microsoft Translator APIをVBAから呼び出すコードについて記事を書きました。
・Microsoft Translator APIで文字列を翻訳するVBAマクロ
//www.ka-net.org/blog/?p=6697
以前書いた記事「Google翻訳の言語自動検出機能を追う」でGoogle翻訳の言語を自動的に検出する仕組みについて調べてみましたが、今回は検出された言語以外の部分に着目してみます。
まずは翻訳にかけたときのHTTPヘッダを改めて確認してみると下記のようになっていました。
POST /translate_a/t HTTP/1.1 Host: translate.google.co.jp Content-Type: application/x-www-form-urlencoded;charset=utf-8 client=t&text=%5B%E6%8C%BF%E5%85%A5%5D%20%E3%82%BF%E3%83…&hl=ja&sl=auto&tl=en&multires=1&prev=conf&psl=ja&ptl=en…
「Google翻訳の言語自動検出機能を追う」のときは短文を翻訳にかけたのでGETになっていましたが、今回は長文でテストしたのでPOSTになっています。
そして返ってきた結果(responseText)が下記になります。
[[["The gallery of the Insert tab , which contains the items…]],[[0,5],[21,22]],""]],,,[["ja"]],7]
上記結果を見ると以前調べたときと同様の形で返ってきていることが分かります。
であれば、POSTするパラメータ「client」の値を「t」以外にすれば扱いやすいJSON形式で返ってくるはずなので、早速試してみました。
{"sentences":[{"trans":"The gallery of the Insert tab, which contains the items…, "translit":"","src_translit":"Bunsho no teisai o genzai no tenpur?to o hozon shimasu."}],"src":"ja","server_time":497}
予想通りの結果です。
以前はこの結果から”検出された言語“を示しているであろう「src」を利用したのですが、配列”sentences“にあるtransやtranslitを利用すれば、訳文や音訳を得ることができそうです。
この「trans」を利用してGoogle翻訳で翻訳を行うマクロを早速書いてみました。
Option Explicit
Public Sub Sample()
Dim s As String
'テスト用文字列は http://ja.wikipedia.org/wiki/Microsoft より
s = "当初は世に登場して間もない8ビットのマイクロプロセッサを搭載したコンピュータ「アルテア (Altair)」上で動く、BASICインタプリタの開発・販売で成功を収めた。" & vbCrLf
s = s & "当初はネイティブ環境(カセットテープベースでオペレーティングシステムはなくROM-BASICに近い環境のもの)だったが、CP/Mが標準プラットフォームとなると、CP/MベースのMBASICを発表する。グラフィックス機能をつけたGBASIC、16ビット用のGWBASICが登場する。なお、GWのWは16ビットを意味するダブルバイト/ワードだとされている。" & vbCrLf
s = s & "ついでIBM PC上のオペレーティングシステムの開発を請け負い、シアトルコンピュータプロダクツの86-DOSの権利を購入し改良、PC DOS(自社ブランドでMS-DOS)を開発。IBM PCとそれら互換機の普及と共にオペレーティングシステムの需要も伸び、現在に至る地固めを確かなものとした。86-DOSの開発者ティム・パターソンは後にマイクロソフトに引き抜かれMS-DOSの開発メインスタッフとなる。"
With CreateObject("WScript.Shell")
.Popup TranslateGoogle(s) '言語自動検出から英語(デフォルト)
.Popup TranslateGoogle(s, , "th") '言語自動検出からタイ語
.Popup TranslateGoogle(s, "ja", "ar") '日本語からアラビア語
End With
'テスト用文字列は http://en.wikipedia.org/wiki/Microsoft より
s = "Microsoft Corporation (NASDAQ: MSFT) is an American multinational corporation headquartered in Redmond, Washington, United States that develops, manufactures, licenses, and supports a wide range of products and services predominantly related to computing through its various product divisions." & vbCrLf
s = s & "Established on April 4, 1975 to develop and sell BASIC interpreters for the Altair 8800, Microsoft rose to dominate the home computer operating system market with MS-DOS in the mid-1980s, followed by the Microsoft Windows line of operating systems." & vbCrLf
s = s & "Microsoft would also come to dominate the office suite market with Microsoft Office."
With CreateObject("WScript.Shell")
.Popup TranslateGoogle(s, , "ja") '言語自動検出から日本語
.Popup TranslateGoogle(s, "en", "ta") '英語からタミル語
.Popup TranslateGoogle(s, "en", "zh-CN") '英語から簡体中国語
End With
End Sub
Private Function TranslateGoogle(ByVal target As String, Optional ByVal FromLng As String = "auto", Optional ByVal ToLng As String = "en") As String
Dim dat As Variant
Dim ret As String
Dim js As String
Dim itm As Object
Dim cnt As Long
Dim sentences, length '小文字表示用ダミー
Const url As String = "http://translate.google.com/translate_a/t"
ret = "": js = "": cnt = 1 '初期化
dat = "client=0&sl=" & FromLng & "&tl=" & ToLng & "&text=" & EncodeURL(target)
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
.Send dat
If .Status = 200 Then js = .responseText
End With
On Error GoTo 0
If Len(js) > 0 Then
js = "(" & js & ")"
With CreateObject("ScriptControl")
.Language = "JScript"
'Debug.Print .CodeObject.eval(js).sentences.length
For Each itm In .CodeObject.eval(js).sentences
If cnt = 1 Then
ret = ret & itm.trans
Else
ret = ret & vbCrLf & itm.trans
End If
cnt = cnt + 1
Next
End With
End If
TranslateGoogle = ret
End Function
Private Function EncodeURL(ByVal sWord As String) As String
With CreateObject("ScriptControl")
.Language = "JScript"
EncodeURL = .CodeObject.encodeURIComponent(sWord)
End With
End Function
翻訳対象の文字列と元の言語、翻訳する言語を引数として渡すと、Google翻訳で翻訳した結果を返すマクロとなっています。
なお、結果はsentences(文章)の中から一文一文返すのではなく、各文を改行で結合したものを返すようにしています。
有料化に伴って利用できなくなったGoogle Translate API v1の代わりとして、今回のコードは利用できそうです。
(これも公式では無さそうなので、いつ利用できなくなるのかは分かりませんが…)

















この記事へのコメントはありません。