ExcelでGoogle Translateを呼び出すマクロ

Google Spread SheetのGoogleTranslate関数ってすごいなーって思い、Excelでも何かしらできないかなと思い作ってみた。
できるだけ汎用的にするためにAPIは使わないようにしようとしてみた。
自分だけの備忘になるのかなと思うのですがご参考までに。

1. で、結局なにができたの？

VBA上で、GoogleTranslate("hello!", lgEnglish, lgJapanese) とすると、英語の"hello!"をGoogle translateで翻訳して"こんにちは！"と返してくれる関数を作ってみた。

2.詳細を教えて？ででてくるのコードを全部vbeに貼り付けて、その後に次のsampleコードをvbeにコピペして実行すると"A1"セルの英語テキストを"B1"に日本語にして返してくれるよ！

Sample

Sub translate_sample()

Set wb = Thisworkbook
Set ws = wb.worksheets("Sheet1")

Dim str_en as String

str_en = ws.Cells(1,1).text
str_jp = GoogleTranslate(str_en, lgEnglish, lgJapanese)

ws.Cells(1,2) = str_jp

End Sub

2. 詳細をおしえて？

まずは、ほとんど以下のサイトにある内容をとってくる。
が、2018年の12月にGoogle Translateのソースが変更されたようで、うまいこと動かない。。

▼Google翻訳で文字列を翻訳するVBAマクロ(IE操作版)
https://www.ka-net.org/blog/?p=7694

そこで、少々修正を加えたものをのせとく。
まずは、引用元のコードを丸パクリして「言語コードを元に適切な翻訳ページを呼ぶ」準備をする。

Enum_Lang

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

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

そして次に、訳したいテキストをGoogle Translateのページに貼り付けて、翻訳ボタンをクリックして、翻訳後のテキストを取得する関数を作ってみた。

GoogleTranslate

Private Function GoogleTranslate(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
  Dim elmResult As Object 'HTMLOutputElement

  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
     Application.Wait Now + TimeValue("00:00:05")

    '翻訳後テキストを取得
    On Error Resume Next
    Set elmResult = .document.getElementsByClassName("result-shield-container tlid-copy-target")(0)
    On Error GoTo 0

    If Not elmResult Is Nothing Then
        GoogleTranslate = elmResult.innerText
    Else
        MsgBox "error:" & elmResult.innerText
    End If

  End With

End Function

こんな感じかな。