Excel

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

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

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

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

Option Explicit

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

Public Sub Sample()
  OpenGoogleTranslate "今日の天気は曇りです。", lgJapanese, lgYoruba
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 elmClear As Object 'HTMLDivElement
  Dim elmOtfSwitch As Object 'HTMLAnchorElement
  Dim elmSourceArea As Object 'HTMLTextAreaElement
  Dim elmSubmit As Object 'HTMLInputElement
  Const READYSTATE_COMPLETE = 4
  
  '言語コード取得
  src_cd = GetLangCode(SourceLanguage)
  target_cd = GetLangCode(TargetLanguage)
  
  url = "https://translate.google.co.jp/?hl=ja#" & src_cd & "/" & 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
    While .Busy Or .readyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    
    'テキストを消去ボタンクリック
    On Error Resume Next
    Set elmClear = .Document.getElementById("gt-clear")
    On Error GoTo 0
    If Not elmClear Is Nothing Then elmClear.Click
    
    'リアルタイム翻訳を無効にする
    On Error Resume Next
    Set elmOtfSwitch = .Document.getElementById("gt-otf-switch")
    On Error GoTo 0
    If Not elmOtfSwitch Is Nothing Then
      If InStr(elmOtfSwitch.innerText, "無効") Then elmOtfSwitch.Click
    End If
    
    '翻訳元テキストエリアに値をセット
    On Error Resume Next
    Set elmSourceArea = .Document.getElementById("source")
    On Error GoTo 0
    If Not elmSourceArea Is Nothing Then
      elmSourceArea.Value = TranslateText
    End If
    
    '翻訳ボタンクリック
    On Error Resume Next
    Set elmSubmit = .Document.getElementById("gt-submit")
    On Error GoTo 0
    If Not elmSubmit Is Nothing Then elmSubmit.Click
  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("is", "ga", "az", "af", "am", "ar", "sq", "hy", "it", "yi", _
            "ig", "id", "cy", "uk", "uz", "ur", "et", "eo", "nl", "kk", _
            "ca", "gl", "kn", "el", "ky", "gu", "km", "ku", "hr", "xh", _
            "co", "sm", "jv", "ka", "sn", "sd", "si", "sv", "zu", "gd", _
            "es", "sk", "sl", "sw", "su", "ceb", "sr", "so", "th", "tl", _
            "tg", "ta", "cs", "te", "da", "de", "tr", "ny", "ne", "no", _
            "ht", "ha", "ps", "eu", "haw", "hu", "pa", "my", "hi", "fi", _
            "fr", "bg", "vi", "iw", "be", "fa", "bn", "pl", "bs", "pt", _
            "mi", "mk", "mg", "mr", "ml", "mt", "ms", "mn", "hmn", "yo", _
            "lo", "la", "lv", "lt", "ro", "lb", "ru", "en", "ko", "fy", _
            "zh-CN", "zh-TW", "ja", "auto")
  GetLangCode = v(LangNo)
End Function

googletranslate_vba_ie_01

言語コードのせいでコードが長くなっていますが、やっていることは単純です。
Internet ExplorerでGoogle翻訳を開いて文字列をテキストエリアに設定、「翻訳」ボタンをクリックしているだけです。

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

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

Public Sub Sample2()
  OpenGoogleTranslate Selection.Text
End Sub

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

関連記事

  1. Office関連

    Office 365 APIをVBAから呼び出す(2)

    前回の記事ではOffice 365とAzure ADの紐づけを行いまし…

  2. Office関連

    [Outlook]仕分けルールでスクリプト(マクロ)を実行する。

    Msdn フォーラムにあった質問関連でメモを残しておきます。…

  3. Office関連

    [Mayhem]PowerPointマクロにショートカットキーを割り当てる。

    2012/4/20 追記:クイックアクセスツールバーのメニューを利用す…

  4. Excel

    RSSの日付を変換するVBAマクロ

    RSSから取得した日付(「Wed, 20 Dec 2017 00:02…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP