SeleniumVBAでGoogle和英訳 -

SeleniumVBAを使ったグーグル翻訳のマクロです。ドライバーなどインストール不要でどの環境でも動作します。

文章の和文英文の量的判断により、動的に和英訳を行います。数値や「。」などの記号等で誤って英文解釈されることを回避しています。また、スクリプトではJSを使用しないことで、「'：シングルクォーテーション」が入った文章も翻訳可能です。その他、対象翻訳文で和英文が半々の場合や、ラグによる翻訳が元の文のまま進んでしまうことも避けています。

記事の内容

・挙動

・コード

・ポイント機能

・関連機能について（SeleniumVBAのメソッド、Google翻訳の例外）

挙動

コード

SeleniumVBAのダウンロードや使用前の準備については下記をご参照ください。（一部デバック用メモをあえて残しています）

・SeleniumVBAのダウンロード：Releases · GCuser99/SeleniumVBA

・SeleniumVBAのダウンロードからの手順：[Excel VBA]WebDriver経由でブラウザ操作（SeleniumVBA使い方メモ） #ExcelVBA - Qiita

SeleniumVBAをダウンロードし、標準フォームに2つ標準プロシージャを作成し、下記2コードを貼り付けてください。

➤①翻訳用コード

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" ( _
        ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SetForegroundWindow Lib "user32" ( _
        ByVal hwnd As Long) As Long
#End If



Sub GHonyaku()    
                                
    Dim driver As SeleniumVBA.WebDriver
    Dim mngr As SeleniumVBA.WebDriverManager
    Dim keys As SeleniumVBA.WebKeyboard
    Dim keySeq As String
    Dim rlt As String
    Dim timer As Long
    Dim PreTrgtTexts As String, TrmdPreTrgtTexts As String, PreTransTexts As String
    Dim CrtTrgtTexts As String, TrmdCrtTrgtTexts As String, CrtTransTexts As String
    
    
    
    '英訳の場合true
    Dim flag As Boolean: flag = False
    
    
    Set driver = SeleniumVBA.New_WebDriver
    Set keys = SeleniumVBA.New_WebKeyboard
    Set mngr = SeleniumVBA.New_WebDriverManager
 
   'WebDriverを自動更新するWebDriverManagerクラスを使用する
    mngr.AlignChromeDriverWithBrowser
    
    Dim transrng As Range, rng As Range
     On Error Resume Next
      Set transrng = Application.InputBox("和訳したいセルを選択してください", , , , , , , 8)
      If transrng Is Nothing Then Exit Sub
     On Error GoTo 0
      
    'Edgeを選択してブラウザを開く
    driver.StartEdge
   
    Dim caps As WebCapabilities, invisible As Boolean
    ' invisibleをなくしてもいいように見えるがなくすと画面で出てきてしまう
    driver.OpenBrowser caps, invisible = True
      
    'Google翻訳を開く
    driver.NavigateTo "https://translate.google.com"  
    driver.Wait 500
    
    
    
    '訳したい文字列の右に空欄が無ければ訳の欄を作る
    If Not IsEmpty(transrng.Offset(, 1)) Then
        If Not transrng.ListObject Is Nothing Then
        ' テーブル内の場合は ListColumns.Add を使う
            transrng.ListObject.ListColumns.Add Position:= _
            transrng.Column - transrng.ListObject.Range.Column + 2
        Else
        ' テーブル外なら普通に列挿入
            transrng.Offset(, 1).Insert Shift:=xlShiftToRight
        End If
End If

    Call BringWorkbookToFront
    
    Dim x As Long
    x = 0
    '翻訳文が自動判定され誤判定されるのを回避
    driver.FindElement(By.ID, "i12").Click
    
    For Each rng In transrng
        x = x + 1
    '空欄の場合-を入力
        rlt = RemoveValues(rng.Value)
        rlt = Trim(rlt)
        If rlt = "" Then
        'driver.FindElement(By.className, "er8xn").SendKeys "わをん"
        On Error Resume Next
        driver.FindElement(By.CssSelector, "button[aria-label='原文を消去']").Click
        On Error GoTo 0
        GoTo Nextrng
          
        ElseIf IsNumeric(rlt) Then
            rng.Offset(, 1) = rng.Value
                If x >= 2 Then
                    On Error Resume Next
                    driver.FindElement(By.CssSelector, "button[aria-label='原文を消去']").Click
                    On Error GoTo 0
                End If
                GoTo Nextrng
        ElseIf Len(rlt) <= 3 Then
            If Not isJapaneseText(rlt) Then
                rng.Offset(, 1) = rng.Value
                If x >= 2 Then
                    On Error Resume Next
                    driver.FindElement(By.CssSelector, "button[aria-label='原文を消去']").Click
                    On Error GoTo 0
                End If
                GoTo Nextrng
            End If
        End If
    
            CrtTrgtTexts =rng.Value
        
        'ブラウザにおけるデフォルトの自動検出は和英混合文の場合翻訳ミスが起きるため、
        'ブラウザ上での訳文を英語に設定する
        
       '文を日本語か判断して英訳ならTrue
        If isJapaneseText(CrtTrgtTexts) Then
            flag = True
            driver.FindElement(By.ID, "i16").Click
        End If
     
    driver.FindElement(By.className, "er8xn").SendKeys CrtTrgtTexts
    
    'JSでやるとDOM直接操作で早く、複雑な操作可能だが、'がある場合誤判定などある為避ける
    'Dim script As String
    'script = "document.getElementsByClassName('er8xn')[0].value = '" & CrtTgtTexts & "';"
    'driver.ExecuteScript script
    'driver.FindElement(By.className, "er8xn").SendKeys keys.EnterKey
    
    '一文字でも約800は必要
    driver.Wait 1000
    
        'MsgBox driver.FindElement(By.className, "HwtZe").GetText

        On Error Resume Next
        rlt = driver.FindElement(By.className, "HwtZe").GetText
            Do While rlt = ""
                'driver.Wait 100
                rlt = driver.FindElement(By.className, "HwtZe").GetText
            Loop
          '  timer = 0
            If Not flag Then
                timer = 0
                Do Until isJapaneseText(rlt) = True Or timer >= 5
                    rlt = driver.FindElement(By.className, "HwtZe").GetText
                    driver.Wait 500
                    timer = timer + 1
                Loop
            Else
                timer = 0
                Do Until isJapaneseText(rlt) = False Or timer >= 5
                    rlt = driver.FindElement(By.className, "HwtZe").GetText
                    driver.Wait 500
                    timer = timer + 1
                Loop
            End If
            
            'rlt = Replace(rlt, vbCrLf, "")
                  
            'MsgBox rlt = rng.Offset(-1, 1).Value  'Then MsgBox "訳文が前回と同じ"
            'MsgBox rlt = rng.Offset(-1).Value  'Then MsgBox "訳対象文が転記されている"
            
              'rlt:翻訳結果は空欄など削除済みのCrttrgtTexts:翻訳対象文を反映している
              '調整済みのrltと比較するため、比較対象であるシート上の前回翻訳対象文:PreTrgtTexts、今回文:CrtTrgtTextsも同様に空欄等削除する必要がある
              'その上でrltを前回翻訳対象文、前回翻訳結果、今回翻訳対象文と比較し、3つが転記されるエラーを回避
            If x >= 2 Then
                timer = 0
                PreTrgtTexts = rng.Offset(-1).Value
                PreTransTexts = rng.Offset(-1, 1).Value
                TrmdPreTrgtTexts = RemoveValues(PreTrgtTexts)
                TrmdCrtTrgtTexts = RemoveValues(CrtTrgtTexts)
                
            
                'ラグ等により、前回翻訳対象文:PreTrgtTexts、前回翻訳結果:PreTransTexts、今回翻訳対象文:CrtTrgtTextsが結果になる場合のエラー処理
                If rlt = PreTrgtTexts Or rlt = TrmdPreTrgtTexts Or rlt = PreTransTexts Or rlt = CrtTrgtTexts Or rlt = TrmdCrtTrgtTexts Then
                    '翻訳対象文が前回翻訳対象文とは違う場合のみ再度翻訳結果取得処理をかける
                    If CrtTrgtTexts <> TrmdPreTrgtTexts Then
                        Do While rlt = PreTrgtTexts Or rlt = TrmdPreTrgtTexts Or rlt = PreTransTexts Or rlt = CrtTrgtTexts Or rlt = TrmdCrtTrgtTexts
                            rlt = driver.FindElement(By.className, "HwtZe").GetText
                            driver.Wait 1000
                            timer = timer + 1
                            Debug.Print timer
                            If timer >= 5 Then
                                Debug.Print "同じ訳文転記" & rlt
                                Exit Do
                            End If
                        Loop
                     End If
                End If
            End If
            
            
        On Error GoTo 0
        
        rng.Offset(, 1) = rlt
        rng.Offset(, 1).WrapText = True
     
        If flag Then
            flag = False
            driver.FindElement(By.ID, "i15").Click
        End If
        'JSで入力していない事で訳文が残ったままになる為、削除する
Nextrng:
    driver.ExecuteScript "document.getElementsByClassName('er8xn')[0].value = '';"
    

Next
    
    MsgBox "完了しました"
    
    
    
End Sub


Sub BringWorkbookToFront()
    Dim hwnd As LongPtr
    Dim wb As Workbook

    ' 対象のワークブック
    Set wb = ActiveWorkbook

    ' ウィンドウハンドルを取得
    hwnd = FindWindow("XLMAIN", Application.caption)
    If hwnd = 0 Then
        MsgBox "ウィンドウハンドルが見つかりません。", vbCritical
        Exit Sub
    End If

    ' ワークブックを最前面に移動
    SetForegroundWindow hwnd
End Sub

Function RemoveValues(texts As Variant)
    Dim targetString As String
    Dim removeList As Variant
    Dim i As Long

    removeList = Array(" ", "　", vbCr, vbLf, vbCrLf)

   
    For i = LBound(removeList) To UBound(removeList)
        texts = Replace(texts, removeList(i), "")
    Next i

    RemoveValues = texts
    
End Function

➤②日本語判定関数コード

Option Explicit

Function isJapaneseText(inputText As String) As Boolean

    ' 日本語の文字をカウントする
    Dim japaneseCount As Integer
    japaneseCount = CountJapaneseCharacters(inputText)
    
    ' 文字列全体の長さを取得
    Dim totalLength As Integer
    totalLength = Len(inputText)
    
    ' 日本語の文字が50%以上を占めているか確認
    If totalLength > 0 And (japaneseCount / totalLength) >= 0.5 Then
        isJapaneseText = True
    Else
        isJapaneseText = False
    End If
End Function

' 日本語の文字をカウントする関数
Function CountJapaneseCharacters(inputText As String) As Integer

    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    ' ひらがな、全角カタカナ、半角カタカナ、日本語の漢字、句読点（。、）を含める
    regex.Pattern = "[\u3040-\u309F\u30A0-\u30FF\uFF61-\uFF9F\u4E00-\u9FFF々〆?、。]"
    regex.IgnoreCase = True
    regex.Global = True
    
    ' 一致する文字をカウントして返す
    Dim matches As Object
    Set matches = regex.execute(inputText)
    CountJapaneseCharacters = matches.Count
End Function

SeleniumVBAをダウンロードし保存する際には下記のような表示が出ます。これはSeleniumVBAファイルによる仕様のため、無視していただいて問題はありません。

ポイント機能

使用前にエクセルの参照設定が下記の設定と過不足がないか確認してください。不足しているとうまく動作しない可能性があります。

翻訳対象文の右側に空欄を開け、訳文を転記
和英文の量的判定（②日本語判定関数）
翻訳対象の文章が英文なら訳結果が訳文になるまで待機
エラー回避（JS記載を避け、シングルクォーテーション時のエラー、動作遅延による一つ前の文章訳を回避）

翻訳対象文の右側に空欄を開け、訳文を転記

今マクロでは翻訳対象文を選択した後、翻訳文を記載する空欄を左に作成します。そして上から順に訳文をFor each で取得、Google翻訳に転記＆翻訳後の文章を空欄に転記しています。

高速化処理として、空欄の場合、数字だけの場合、文字が日本語以外で3文字に満たない場合を訳文非対称と見なし、Google翻訳上の原文を消去ボタンを押し、次の処理に移る処理をしています。

これにより余計な翻訳処理を飛ばし高速化しています。日本語と異なり、英語の場合は3文字であればほとんど訳せない場合が多いため、そのままとしています。

和英文の量的判定（②日本語判定関数）

和文の定義は、「ひらがな、全角カタカナ、半角カタカナ、日本語の漢字、句読点（。、）を含めた文章が全体の内半数以上の場合」

としています。

全角/半角のひらがな、カタカナ、漢字が入っている場合は日本語と判定して英訳、それ以外は英訳するようになっています。

句読点等の記号でも日本語の判定は可能ですが、全角コロン「：」などの記号は日本語になってしまい、例えば英語の文でも記号が入っていると和文と認識してしまうため、和文判定基準からは除外しています。

関数は2つあり、

①日本語の割合から和文を判断する関数と、

②日本語の量を数える関数です。①から②を呼び出し、①で割合を計算し和英判断をしています。

②では引数を受け取り、標準表現Regexを使用することで和文を数えます。

Regexの使用では参照設定で事前バインディングを行います。これをすることでピリオドを押すとIntelliSenseが機能し入力しやすくなります。

Regex（正規表現）とは、特定のパターンに一致する文字列を検索・置換・抽出するための表記法です。プログラミングやデータ処理で広く使用されます。数値や日本語など様々な文字は正規表現を使うことでより細かく、包括的に操作することが可能です。

例えば日本語であれば、平仮名などの其々の形態ごとに正規表現があり、簡単に操作が可能です。

ひらがな → [ぁ-ゖ]
カタカナ（全角） → [ァ-ヶ]
カタカナ（半角） → [ｦ-ﾟ]
漢字 → [々〇〻\u3400-\u9FFF\uF900-\uFAFF]

Regexを使った文字カウントでは基本的なスクリプトが決まっています。オブジェクト変数にRegexを割り当て、Patternに対象にしたい文字や記号を指定、IgnoreCaseで大文字小文字区別するかを指定し、Globalで対象の文字列すべてを検索するか、最初に見つけるまでとするかを設定します。今回は、ひらがな～句読点まで日本語に現れ、英語には表れない表現を指定し、IgnoreCace、GlobalをTrueにしたことで、大文字に関係なく、対象文章からすべての日本語を捜査対象にしています。

上記条件での該当がどれくらいあるかは、Countメソッドで取得できます。変数matchesに上記のRegexをexecute（引数）を設定し、捜査実施後、Countをすることで指定文字列の数を取得できます。

エラー回避（動作遅延や空欄時等）

今回のVBAでは、①翻訳対象文と②翻訳後の文を変数に入れ、翻訳をしています。また、複数の翻訳文がある場合、③一つ前の翻訳対象文と、④一つ前の翻訳後の文も比較をしています。これにより、意図しない翻訳を回避しています。

プロシージャのテストでは、

①一つ前の翻訳結果が今回の翻訳対象文の翻訳結果として処理されるエラー、

②一つ前の翻訳対象文が今回の翻訳対象文の翻訳結果として処理されるエラー、

③今回の翻訳対象文自体が転記されてしまうエラー、の3つがありました。

それぞれを変数として判断することで、これら翻訳エラーを回避しています。

上記のスクリプトでは、上記エラー回避のために変数を代入しています。RemoveVlaues関数では、文字列の空欄、開業をすべて削除しています。

実はグーグル翻訳では、翻訳をした後に翻訳対象文の空欄が削除されます（空欄はそのまま）。その為、上記エラーを判断するためには同じように空欄を削除する必要がある為、関数で処理しています。

翻訳対象文が一つ前の翻訳対象文と同じ場合のみ、上記の変数を条件分岐処理します。

Do Loopにより訳文が異なる結果になるまでドライバーを繰り返し実行させています。翻訳対象文が一つ前の翻訳対象文と同じ場合のみ実行することで、高速化処理しています。

5秒経っても変わらない場合は、ブラウザ等のエラーとしてそのまま転記させています。スクリプト内のwaitミリ秒数を減少させればさらに高速化できますが、安定しない場合があります。

Google翻訳での翻訳は、訳文貼り付け→翻訳と、ブラウザ上で翻訳までに多少の遅延があります。また、PCのスペックやネット接続状況でも遅延が起きてしまいます。これにより①、②のエラーが起きます。
①については、一つ前の翻訳後の文が英語であり、その次の翻訳対象文が日本語で訳文の場合、一つ前の翻訳後の文がブラウザに残っていた場合、日本語の文が一つ前の翻訳文にもかかわらず処理が進んでしまいます。（つまり、一つ前の翻訳後の文が和文であり、今回は英訳したい場合、前回の翻訳後の文がブラウザ上に残っている為、今回の翻訳対象文をブラウザの要素に送っても翻訳されているようになってしまう）