【Excel-VBAで自動翻訳】Google翻訳からデータを取得するマクロ

最近は「グローバル化」「労働者不足問題」などの背景があり、日本にも外国人労働者が急増加しています。

そこで、本記事ではExcelの資料を自動で翻訳してくれるマクロの紹介をします。

特に最近はGoogle翻訳に機械学習（AIのようなイメージ）が採用され、翻訳の精度が大幅に向上してきております。

今後ますます進む外国人労働者の増加に先駆けて書類の多言語化に貢献できたら幸いです。

＜＜選択されたセルを翻訳するマクロ＞＞

やっていることはInternet Explorerを開き、Google翻訳のURLにアクセスしテキストを入力、翻訳後の結果をコピーして貼り付けるというものです。（HTMLから情報を得ることを行っています）

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 Google翻訳()
  OpenGoogleTranslate Selection.Text
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
  Dim elmResults As Object 'HTMLInputElement
  Dim X As Integer
  Dim Y As Integer
  Dim button As Object
  Dim Sheetname As String
  Dim inSheetname As String
  
  Const READYSTATE_COMPLETE = 4
  
  '決めごと
  X = ActiveCell.Row
  Y = ActiveCell.Column
  inSheetname = ActiveSheet.Name
  Sheetname = ActiveSheet.Name + " (2)" 
   
  '言語コード取得
  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 elmSourceArea = .document.getElementById("source")
    On Error GoTo 0
    If Not elmSourceArea Is Nothing Then
      elmSourceArea.Value = TranslateText
    End If
    
    Call WaitFor(3)
    
    'コピーボタンをクリック
    For Each button In .document.getElementsByClassName("copybutton")
      button.Click
      Exit For
    Next
    
     Worksheets(Sheetname).Cells(X, Y).PasteSpecial
    
    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
'指定した秒だけ停止する
Function WaitFor(ByVal second As Integer)
    Dim futureTime As Date
 
    futureTime = DateAdd("s", second, Now)
 
    While Now < futureTime
        DoEvents
    Wend
End Function

決め事として翻訳前のシートをシートごとコピーして準備が必要です。

シート名：A　→　シート名：A (2)

このようにシートを単純にコピーすれば (2)がつくのでこの状態でOKです。

シートA (2)に英訳（翻訳後の言語）が記入されていきます。

また、マクロ実行時はシートAの翻訳したいセルを選択する必要があります。

さらに、Optional ByVal TargetLanguage As Lang = lgEnglish

の「lgEnglish」の部分を変更することで100ヶ国語の中から翻訳言語を選べます。

最後に・・・

VBAの参考書籍としておすすめな本を紹介しています。