Excel

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

OWSPostDataオブジェクトを使って文字列をエンコードするVBS前のページ

Office 2010のオブジェクトリスト次のページ

関連記事

  1. Office関連

    ルビ(ふりがな)を一括設定するWordマクロ

    2016/10/28 追記:改良版のマクロを書きました。…

  2. アイコン一覧

    Office 2013 アイコン一覧(I)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    ソースコードを番号行付きのテーブルに変換するWordマクロ

    Word文書内のソースコードを、他の文書と区別して目立たせたいときに役…

  4. Office関連

    [リボン・カスタマイズ]dropDown要素の初期項目を指定する。

    MSDN フォーラムに「リボン:ドロップダウンリストにlabel初期値…

  5. Office関連

    「VBA質問箱」にアクセスできない。

    2013/03/19 追記:ドメインが更新されVBA質問箱が閲覧で…

コメント

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP