Excel VBAで英日自動翻訳

2022年8月25日 01:40

Excel VBAでA列に入っている英語の文章を自動的に日本語に翻訳するVBAのプログラムです。Weblio翻訳を使用しています。
まずは全体像を載せます。

'一定時間停止するためのAPI
#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'HTMLの取得
Private Function Get_HTML(ByVal Words As String) As String
    Dim html As String
    Dim http As Object
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    http.Open "GET", "https://translate.weblio.jp/?lp=EJ&lpf=EJ&originalText=" + UrlEncode(Words), False
    http.Send
    
    ' ダウンロード待ち
    Do While http.readyState <> 4
    Loop
    
    ' 結果出力
    html = http.responseText
    
    Get_HTML = html
    
    
    '解放
    Set http = Nothing
    
    
End Function

'URLエンコード用
Function UrlEncode(mySource As Variant) As String
'もし32bitのExcelや2016以前のExcelを使っている場合は以下のコメントアウトを解除して
'UrlEncode = ...の部分をコメントアウトする。


'    '変数の宣言
'    Dim objSC As Object 'ScriptControlオブジェクトを格納するための変数
'
'    'ScriptControlオブジェクトのインスタンスを生成
'    Set objSC = CreateObject("ScriptControl")
'
'    'ScriptControlオブジェクトの言語をJScriptに設定
'    objSC.Language = "JScript"
'
'    '関数の戻り値として、引数mySourceをURLエンコードした値をセット
'    UrlEncode = objSC.CodeObject.encodeURIComponent(mySource)
'
'    'ScriptControlオブジェクトを破棄
'    Set objSC = Nothing
    
    UrlEncode = WorksheetFunction.EncodeURL(mySource)
 
End Function


'HTMLから意味の抽出
Public Function Get_Meaning_From_HTML(ByVal Word As String) As String
    'On Error GoTo MeanError
    
    Dim html As String
    html = Get_HTML(Word)
    
    
    Dim MeanStr As String   '意味を入れておく変数
    Dim MeanStart As Integer, MeanEnd As Integer    '意味の入っている文字列のはじめと終わりの位置
    
    '基準となるポイントを探して意味を抜き出す
    MeanStart = InStr(html, "name=" + Chr(34) + "translatedText" + Chr(34) + " value=" + Chr(34)) + Len("name=" + Chr(34) + "translatedText" + Chr(34) + " value=" + Chr(34))
    MeanEnd = InStr(html, "id=translatedText")
    
    MeanStr = Mid(html, MeanStart, MeanEnd - MeanStart)
    
    '返す
    Get_Meaning_From_HTML = MeanStr
    
    Exit Function
       
MeanError:
    '返す
    Get_Meaning_From_HTML = ""
    
End Function


'実行するのはこの関数
Sub Translate()
    'Weblio翻訳からデータを取得する
    On Error Resume Next
    
    Dim i As Integer
    Dim mean As String
    
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        '既に値が入っていない場合のみ翻訳して速度改善
        If Cells(i, 2).Value = "" Then
           '取得したHTMLのタグを検索して解析する
            mean = Get_Meaning_From_HTML(Cells(i, 1).Value)
            
            '改行手前で切り取る
            Dim CL As Long: CL = InStr(mean, vbLf)
            If CL = 0 Then
                CL = Len(mean)
            End If
            mean = Mid(mean, 1, CL)
            
            '改行をなくす
            mean = Replace(mean, vbLf, "")
            mean = Replace(mean, vbCrLf, "")
            
            ' "を取り除く
            mean = Replace(mean, Chr(34), "")
            mean = Replace(mean, "'", "")
            
            '出力
            Cells(i, 2).Value = mean
            
            '一時停止してエラーを防ぐ
            Sleep 100
        End If
    Next i

End Sub

以下で各関数について見ていきます。

さて、前半部分にこのようなコードがあります。

'一定時間停止するためのAPI
#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

VBA7はExcel2010以上、Win64は64bit版Windowsという意味です。64bit版Windowsの時はWindows APIを宣言する際にPtrSafeを追加しないとエラーになります。そこで、環境を判断してAPI宣言を切り替えています。Windows APIはWindowsのより基本的な機能にアクセスできるようにMicrosoftが制定したAPIになります。今回は"C:\Windows\System32\kernel32.dll"に含まれるSleep関数を使います。Windows APIの関数はこのようにSystem32フォルダの中に含まれていて、この中の関数を呼び出して使うことになります。Sleep関数はVBAでミリ秒単位で処理を止めることが可能な関数になります。よく使うので関数名だけは覚えておくとよいでしょう。

さて、次を読んでいきます。

'HTMLの取得
Private Function Get_HTML(ByVal Words As String) As String
    Dim html As String
    Dim http As Object
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    http.Open "GET", "https://translate.weblio.jp/?lp=EJ&lpf=EJ&originalText=" + UrlEncode(Words), False
    http.Send
    
    ' ダウンロード待ち
    Do While http.readyState <> 4
    Loop
    
    ' 結果出力
    html = http.responseText
    
    Get_HTML = html
    
    
    '解放
    Set http = Nothing
    
    
End Function

コメントを見てもわかる通り、HTMLを取得するコードですね。

Set http = CreateObject("MSXML2.XMLHTTP")

重要ポイントはここです。MSXML2.XMLHTTPを使い、HTMLを簡単に取得することができます。VBAからExcel外部を参照することになるので、CreateObject関数でObject変数であるhttpにMSXML2.XMLHTTPをオブジェクトとして設定して使えるようになります。この処理は非同期処理なので取得が完了するまでDo～Loopで待機します。詳しい使い方についてはググってください。最後にhtmlを開放することをお忘れなく！

お次はここです。

'URLエンコード用
Function UrlEncode(mySource As Variant) As String
'もし32bitのExcelや2016以前のExcelを使っている場合は以下のコメントアウトを解除して
'UrlEncode = ...の部分をコメントアウトする。


'    '変数の宣言
'    Dim objSC As Object 'ScriptControlオブジェクトを格納するための変数
'
'    'ScriptControlオブジェクトのインスタンスを生成
'    Set objSC = CreateObject("ScriptControl")
'
'    'ScriptControlオブジェクトの言語をJScriptに設定
'    objSC.Language = "JScript"
'
'    '関数の戻り値として、引数mySourceをURLエンコードした値をセット
'    UrlEncode = objSC.CodeObject.encodeURIComponent(mySource)
'
'    'ScriptControlオブジェクトを破棄
'    Set objSC = Nothing
    
    UrlEncode = WorksheetFunction.EncodeURL(mySource)
 
End Function

一つ上で、HTMLを取得するコードを書いたのですが、Weblioの仕様上翻訳する言葉をURLに変換して引数として渡してあげる必要があるため、URLエンコード処理が必要となるのです。Excel2013以降であれば使うことができます。もしそれ以前のExcelを使っている場合は、ScriptControlを用いてJavaScriptにアクセスしてURLエンコード処理を実装する必要があります。

どんどん行きましょう。

'HTMLから意味の抽出
Public Function Get_Meaning_From_HTML(ByVal Word As String) As String
    'On Error GoTo MeanError
    
    Dim html As String
    html = Get_HTML(Word)
    
    
    Dim MeanStr As String   '意味を入れておく変数
    Dim MeanStart As Integer, MeanEnd As Integer    '意味の入っている文字列のはじめと終わりの位置
    
    '基準となるポイントを探して意味を抜き出す
    MeanStart = InStr(html, "name=" + Chr(34) + "translatedText" + Chr(34) + " value=" + Chr(34)) + Len("name=" + Chr(34) + "translatedText" + Chr(34) + " value=" + Chr(34))
    MeanEnd = InStr(html, "id=translatedText")
    
    MeanStr = Mid(html, MeanStart, MeanEnd - MeanStart)
    
    '返す
    Get_Meaning_From_HTML = MeanStr
    
    Exit Function
       
MeanError:
    '返す
    Get_Meaning_From_HTML = ""
    
End Function

これは取得したHTMLから意味を取得する関数です。これは調べる際に実際に検索してHTMLを調べて、欲しい翻訳結果がどうなっているかを調べます。

VBAでスクレイピングするには自力でタグ解析しないといけないので、頑張って欲しいデータを探し出します。できるだけ同じ文字の並びが存在しないものを選ぶほうがいいです。見つかったら前後のタグをもとにタグの中身をInStr関数やMid関数などを用いて抜き出します。

ようやくラストです。

'実行するのはこの関数
Sub Translate()
    'Weblio翻訳からデータを取得する
    On Error Resume Next
    
    Dim i As Integer
    Dim mean As String
    
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        '既に値が入っていない場合のみ翻訳して速度改善
        If Cells(i, 2).Value = "" Then
           '取得したHTMLのタグを検索して解析する
            mean = Get_Meaning_From_HTML(Cells(i, 1).Value)
            
            '改行手前で切り取る
            Dim CL As Long: CL = InStr(mean, vbLf)
            If CL = 0 Then
                CL = Len(mean)
            End If
            mean = Mid(mean, 1, CL)
            
            '改行をなくす
            mean = Replace(mean, vbLf, "")
            mean = Replace(mean, vbCrLf, "")
            
            ' "を取り除く
            mean = Replace(mean, Chr(34), "")
            mean = Replace(mean, "'", "")
            
            '出力
            Cells(i, 2).Value = mean
            
            '一時停止してエラーを防ぐ
            Sleep 100
        End If
    Next i

End Sub

ここはあまり解説はいらないかもですね。最後はここまでで作ってきた関数を組み合わせて整形処理を加えただけです。データを取得してデバッグしていたらわかることなのですが、改行やダブルクォーテーションが混じっていて奇麗な結果が得られません。そこでいらないものを除去する工程が必要になります。この関数はその処理がほとんどですね。

ここまで読んでくださってありがとうございます。この記事が何かの役に立つことを願って。良いExcelライフを！

この記事が気に入ったらサポートをしてみませんか？