下記記事にあるように、ニューラルネット機械翻訳の導入によって、Google翻訳の精度が向上したらしいです。
- 待ってた!ついにGoogle翻訳がニューラルネット機械翻訳を日本語版にも適用。異常に上がった翻訳性能は感動モノ
- https://bita.jp/dml/gtransrate_upgrade
- Google翻訳が進化!? 精度が向上したと話題に
- http://nlab.itmedia.co.jp/nl/articles/1611/12/news021.html
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
さらに、新田さんが紹介しているように、ショートカットキーにマクロを登録しておけば、キー操作一つでマクロを実行できて便利です。


![[VBA]DataObjectを使ったクリップボード操作が上手くいかない場合の対処法](https://www.ka-net.org/blog/wp-content/uploads/eyecatch-OfficeVBA-120x120.png)


















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