Office関連

Google翻訳で文字列を翻訳するVBAマクロ(IE操作版)

下記記事にあるように、ニューラルネット機械翻訳の導入によって、Google翻訳の精度が向上したらしいです。

Google翻訳といえば、当ブログでも数年前に「Google翻訳で文字列を翻訳するマクロ」について記事を書いたのですが、この方法はとっくに使えなくなっています。

本来であれば、有償のGoogle Translate APIを使うべきだと思いますが、今回は方向性を変えて、“Internet Explorerを使ってGoogle翻訳を行う操作”を自動化するVBAマクロを考えてみたいと思います。

2020/12/25 追記:
マクロのコードを書き直しました。
今後もGoogle翻訳の仕様変更により、マクロが使用できなくなる可能性があります。

Option Explicit

Private Enum Lang
  lgAuto = 0 '言語を検出する
  lgIcelandic = 1 'アイスランド語
  lgIrish = 2 'アイルランド語
  lgAzerbaijani = 3 'アゼルバイジャン語
  lgAfrikaans = 4 'アフリカーンス語
  lgAmharic = 5 'アムハラ語
  lgArabic = 6 'アラビア語
  lgAlbanian = 7 'アルバニア語
  lgArmenian = 8 'アルメニア語
  lgItalian = 9 'イタリア語
  lgYiddish = 10 'イディッシュ語
  lgIgbo = 11 'イボ語
  lgIndonesian = 12 'インドネシア語
  lgUyghur = 13 'ウイグル語
  lgWelsh = 14 'ウェールズ語
  lgUkrainian = 15 'ウクライナ語
  lgUzbek = 16 'ウズベク語
  lgUrdu = 17 'ウルドゥ語
  lgEstonian = 18 'エストニア語
  lgEsperanto = 19 'エスペラント語
  lgDutch = 20 'オランダ語
  lgOdia = 21 'オリヤ語
  lgKazakh = 22 'カザフ語
  lgCatalan = 23 'カタルーニャ語
  lgGalician = 24 'ガリシア語
  lgKannada = 25 'カンナダ語
  lgKinyarwanda = 26 'キニヤルワンダ語
  lgGreek = 27 'ギリシャ語
  lgKyrgyz = 28 'キルギス語
  lgGujarati = 29 'グジャラト語
  lgKhmer = 30 'クメール語
  lgKurdish = 31 'クルド語
  lgCroatian = 32 'クロアチア語
  lgXhosa = 33 'コーサ語
  lgCorsican = 34 'コルシカ語
  lgSamoan = 35 'サモア語
  lgJavanese = 36 'ジャワ語
  lgGeorgian = 37 'ジョージア(グルジア)語
  lgShona = 38 'ショナ語
  lgSindhi = 39 'シンド語
  lgSinhala = 40 'シンハラ語
  lgSwedish = 41 'スウェーデン語
  lgZulu = 42 'ズールー語
  lgScotsGaelic = 43 'スコットランド ゲール語
  lgSpanish = 44 'スペイン語
  lgSlovak = 45 'スロバキア語
  lgSlovenian = 46 'スロベニア語
  lgSwahili = 47 'スワヒリ語
  lgSundanese = 48 'スンダ語
  lgCebuano = 49 'セブアノ語
  lgSerbian = 50 'セルビア語
  lgSesotho = 51 'ソト語
  lgSomali = 52 'ソマリ語
  lgThai = 53 'タイ語
  lgFilipino = 54 'タガログ語
  lgTajik = 55 'タジク語
  lgTatar = 56 'タタール語
  lgTamil = 57 'タミル語
  lgCzech = 58 'チェコ語
  lgChichewa = 59 'チェワ語
  lgTelugu = 60 'テルグ語
  lgDanish = 61 'デンマーク語
  lgGerman = 62 'ドイツ語
  lgTurkmen = 63 'トルクメン語
  lgTurkish = 64 'トルコ語
  lgNepali = 65 'ネパール語
  lgNorwegian = 66 'ノルウェー語
  lgHaitianCreole = 67 'ハイチ語
  lgHausa = 68 'ハウサ語
  lgPashto = 69 'パシュト語
  lgBasque = 70 'バスク語
  lgHawaiian = 71 'ハワイ語
  lgHungarian = 72 'ハンガリー語
  lgPunjabi = 73 'パンジャブ語
  lgHindi = 74 'ヒンディー語
  lgFinnish = 75 'フィンランド語
  lgFrench = 76 'フランス語
  lgFrisian = 77 'フリジア語
  lgBulgarian = 78 'ブルガリア語
  lgVietnamese = 79 'ベトナム語
  lgHebrew = 80 'ヘブライ語
  lgBelarusian = 81 'ベラルーシ語
  lgPersian = 82 'ペルシャ語
  lgBengali = 83 'ベンガル語
  lgPolish = 84 'ポーランド語
  lgBosnian = 85 'ボスニア語
  lgPortuguese = 86 'ポルトガル語
  lgMaori = 87 'マオリ語
  lgMacedonian = 88 'マケドニア語
  lgMarathi = 89 'マラーティー語
  lgMalagasy = 90 'マラガシ語
  lgMalayalam = 91 'マラヤーラム語
  lgMaltese = 92 'マルタ語
  lgMalay = 93 'マレー語
  lgMyanmar = 94 'ミャンマー語
  lgMongolian = 95 'モンゴル語
  lgHmong = 96 'モン語
  lgYoruba = 97 'ヨルバ語
  lgLao = 98 'ラオ語
  lgLatin = 99 'ラテン語
  lgLatvian = 100 'ラトビア語
  lgLithuanian = 101 'リトアニア語
  lgRomanian = 102 'ルーマニア語
  lgLuxembourgish = 103 'ルクセンブルク語
  lgRussian = 104 'ロシア語
  lgEnglish = 105 '英語
  lgKorean = 106 '韓国語
  lgChinese = 107 '中国語
  lgJapanese = 108 '日本語
End Enum

Public Sub Sample()
  OpenGoogleTranslate "明日の沖縄の天気は晴れの予報です。", lgJapanese, lgSinhala
End Sub

Private Sub OpenGoogleTranslate(ByVal TranslateText As String, _
                                Optional ByVal SourceLanguage As Lang = lgAuto, _
                                Optional ByVal TargetLanguage As Lang = lgEnglish)
  Dim url As String
  Dim src_cd As String
  Dim target_cd As String
  Dim ie As Object 'Internet Explorer
  Dim elmSourceArea As Object 'HTMLTextAreaElement
  Dim elm As Object
  Const READYSTATE_COMPLETE = 4
   
  '言語コード取得
  src_cd = GetLangCode(SourceLanguage)
  target_cd = GetLangCode(TargetLanguage)
   
  url = "https://translate.google.co.jp/?hl=ja&op=translate&sl=" & src_cd & "&tl=" & target_cd
  Set ie = GetActiveIE("translate.google.co.jp")
  If ie Is Nothing Then
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
      .AddressBar = False
      .MenuBar = False
      .StatusBar = False
      .Toolbar = False
      .Visible = True
    End With
  End If
  With ie
    .Navigate url
    Do While (.Busy = True) Or (.ReadyState <> READYSTATE_COMPLETE)
      DoEvents
    Loop
    
    '原文テキストエリア取得
    On Error Resume Next
    For Each elm In .document.getElementsByTagName("textarea")
      If elm.getAttribute("aria-label") = "原文" Then
        Set elmSourceArea = elm
        Exit For
      End If
    Next
    On Error GoTo 0
    If elmSourceArea Is Nothing Then Exit Sub
    
    '原文をクリップボードにコピーしてテキストエリアに貼り付け
    SetCB TranslateText
    elmSourceArea.Select
    .ExecWB 13, 0
  End With
End Sub

Private Sub SetCB(ByVal str As String)
'クリップボードに文字列を格納
  With CreateObject("Forms.TextBox.1")
    .MultiLine = True
    .Text = str
    .SelStart = 0
    .SelLength = .TextLength
    .Copy
  End With
End Sub

Private Function GetActiveIE(ByVal url As String) As Object
'URLを指定して起動中のIE取得
  Dim o As Object
   
  For Each o In GetObject("new:{9BA05972-F6A8-11CF-A442-00A0C90A8F39}") 'ShellWindows
    If LCase(TypeName(o)) = "iwebbrowser2" Then
      If LCase(TypeName(o.document)) = "htmldocument" Then
        If o.LocationURL Like "*" & url & "*" Then
          Set GetActiveIE = o
          Exit For
        End If
      End If
    End If
  Next
End Function

Private Function GetLangCode(ByVal LangNo As Lang) As String
'言語コード取得
  Dim v As Variant
  
  v = Array("auto", "is", "ga", "az", "af", "am", "ar", "sq", "hy", "it", _
            "yi", "ig", "id", "ug", "cy", "uk", "uz", "ur", "et", "eo", _
            "nl", "or", "kk", "ca", "gl", "kn", "rw", "el", "ky", "gu", _
            "km", "ku", "hr", "xh", "co", "sm", "jw", "ka", "sn", "sd", _
            "si", "sv", "zu", "gd", "es", "sk", "sl", "sw", "su", "ceb", _
            "sr", "st", "so", "th", "tl", "tg", "tt", "ta", "cs", "ny", _
            "te", "da", "de", "tk", "tr", "ne", "no", "ht", "ha", "ps", _
            "eu", "haw", "hu", "pa", "hi", "fi", "fr", "fy", "bg", "vi", _
            "iw", "be", "fa", "bn", "pl", "bs", "pt", "mi", "mk", "mr", _
            "mg", "ml", "mt", "ms", "my", "mn", "hmn", "yo", "lo", "la", _
            "lv", "lt", "ro", "lb", "ru", "en", "ko", "zh-CN", "ja")
  GetLangCode = v(LangNo)
End Function

言語コードのせいでコードが長くなっていますが、やっていることは単純で、Internet ExplorerでGoogle翻訳を開いてテキストエリアに原文を貼り付けているだけです。
(クリップボードに文字列をコピーしている部分のコードは下記記事で解説しています。)

マクロを実行するたびにInternet Explorerが新しく起動するのはPCに負担が掛かってしまうため、すでにInternet ExplorerでGoogle翻訳が開かれているかどうかの判定は行っています。

Officeアプリケーション固有のオブジェクトは使っていないため、WordでもExcelでもマクロを実行することができますが、たとえばWordで下記のようなマクロを用意しておけば、選択した文字列をすぐに翻訳することができます。

Public Sub Sample2()
  OpenGoogleTranslate Selection.Text
End Sub

さらに、新田さんが紹介しているように、ショートカットキーにマクロを登録しておけば、キー操作一つでマクロを実行できて便利です。

【3月のライオン】雪見だいふくコラボカレンダーをゲットしたよ。前のページ

Internet Explorerのタブを切り替えるVBAマクロ次のページ

関連記事

  1. Office アドイン

    Office アドインの概要と開発方法を学ぶための自習書

    2018年10月27日(土)、品川の日本マイクロソフト本社で「2018…

  2. Office関連

    外部からOutlookのマクロを実行するマクロ

    外部からOutlookのマクロを実行するマクロ今回は外部からO…

  3. Office関連

    Presentation Translatorが公開されました。

    下記記事で紹介している「Microsoft Translator アド…

  4. アイコン一覧

    Office 2013 アイコン一覧(A)

    ・Office 2013 アイコン一覧 NUM…

  5. Office関連

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

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

  6. Office アドイン

    作業ウィンドウのアプリをWord 2013にも対応させる。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP