Office関連

Google翻訳で文字列を翻訳するマクロ

※ 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“にあるtranstranslitを利用すれば、訳文や音訳を得ることができそうです。

この「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の代わりとして、今回のコードは利用できそうです。
(これも公式では無さそうなので、いつ利用できなくなるのかは分かりませんが…)

関連記事

  1. Office アドイン

    [Office用アプリ]アプリを削除する。

    「JavaScriptで作成した作業ウィンドウアプリを検証してみる。」…

  2. Office関連

    Wikipediaの検索予測キーワードの一覧を取得するVBAマクロ

    Wikipediaのサーチボックスにキーワードを入力すると、入力したキ…

  3. Office関連

    既存の機能の代わりにマクロを実行する方法をまとめてみました。

    「既存の機能の代わりにマクロを実行する」の関連になりますが、Offic…

  4. Office関連

    [Excel Services ECMAScript]ActiveWorkbookのパスを取得する。…

    埋め込んだExcelワークブックのパスを取得するコードです。 (さ…

  5. アイコン一覧

    Office 2013 アイコン一覧(G)

    ・Office 2013 アイコン一覧 NUM…

  6. Office関連

    Office 2013のコントロールIDリストが更新されました。

    「コントロールID 一覧(Office 2013)」でも紹介しているO…

コメント

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP