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関連

    YouTube動画挿入アドイン for PowerPoint

    前回の記事でPowerPoint 2013でYouTubeの動画が挿入…

  2. Office アドイン

    [Office用アプリ]ユーザー設定を保存する。

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

  3. Office関連

    Office 2007のサポートが2017年10月10日に終了します。

    2007年1月にパッケージ版が発売されてから早10年、長らく活躍してき…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP