ExcelのデータをAI使って英訳したお話

Yukidarumannnn

2024年6月7日 13:32

海外輸出申し込みフォーマット

円安が続き、物価もあがり企業も家庭も厳しい状況が続いていますが、活路に海外での販売に活路を見出す方法もあります。

今回は海外向け販売シートに日本語の記入したら、Google Transform APIを使って新しいタブに英語翻訳をするというものです。

海外との取引においてExcelデータを英語訳するときになどにも使えるかもしれません。

準備

APIキーの設定:

Google Cloud Translation APIから取得します。

JSONコンバータの追加:

VBA-JSON をダウンロードし、VBAプロジェクトにインポートします。
VBAエディタでファイル → ファイルのインポートを選択し、ダウンロードした JsonConverter.bas ファイルをインポートします。

参照設定:
- VBAエディタでツール → 参照設定を選択し、 Microsoft Scripting Runtime にチェックを入れます。

ツール→参照設定→ Microsoft Scripting Runtimeにチェック

今回翻訳元のExcelシート名は”食品フォーム”。これと同じフォームレイアウトを新しいシートにコピーし名前を”食品フォーム(英語)”（既にある場合は追加しない）、日本語になっているセルを英語にする処理を行います。

Sub CopyAndModifySheet()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim ws As Worksheet
    Dim sheetExists As Boolean
    Dim sheetName As String
    Dim cell As Variant
    Dim apiKey As String
    
    sheetName = "食品フォーム(英語)"
    sheetExists = False
    apiKey = "YOUR_API_KEY" ' ここにGoogle Translate APIキーを入力

apiKey="Google Translate APIキー"

        
        ' List of cells to copy and translate
        Dim cellList As Variant
        cellList = Array("J6", "J10", "J33", "J34", "J50", "AI47", "AI50", "J53", "AI53", "J56", "AI56", "P59", "AI59", "J62", "J65", "J67", "AI57", "P60", "AI57", "J57", "AI54", "J54", "AI45", "J51", "J48", "J45", "AI42", "J72", "J74", "AI74")
        
        ' Copy values from source to target sheet and translate if necessary
        For Each cell In cellList
            If Not IsEmpty(wsSource.Range(cell).Value) Then
                wsTarget.Range(cell).Value = TranslateText(wsSource.Range(cell).Value, apiKey)
            End If
        Next cell
    Else
        MsgBox "The target sheet could not be found or created.", vbCritical
    End If
    
    Exit Sub

cellList = Array("J6", "J10", "J33",.…
ここに英訳したい日本語が入っているセル番号を入れていきます。
この例では、J6,J10,J33といったセルに日本語がはいってます。

全コードはこちら

Sub CopyAndModifySheet()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim ws As Worksheet
    Dim sheetExists As Boolean
    Dim sheetName As String
    Dim cell As Variant
    Dim apiKey As String
    
    sheetName = "食品フォーム(英語)"
    sheetExists = False
    apiKey = "YOUR_API_KEY" ' ここにGoogle Translate APIキーを入力
    
    ' Check if the target sheet already exists
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = sheetName Then
            sheetExists = True
            Exit For
        End If
    Next ws
    
    ' Set the source sheet
    Set wsSource = ThisWorkbook.Sheets("食品フォーム")
    
    If sheetExists = False Then
        ' Copy the "食品フォーム" sheet
        wsSource.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        
        ' Rename the copied sheet
        Set wsTarget = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        wsTarget.Name = sheetName
    Else
        ' If the sheet already exists, set wsTarget to the existing sheet
        Set wsTarget = ThisWorkbook.Sheets(sheetName)
    End If
    
    ' Check if wsTarget is set correctly
    If Not wsTarget Is Nothing Then
        ' Clear cells J6 and J10 on the target sheet
        On Error GoTo ErrorHandler ' エラーハンドリングを追加
        If wsTarget.Range("J6").MergeCells Then
            wsTarget.Range("J6").MergeArea.ClearContents
        Else
            wsTarget.Range("J6").ClearContents
        End If
        
        If wsTarget.Range("J10").MergeCells Then
            wsTarget.Range("J10").MergeArea.ClearContents
        Else
            wsTarget.Range("J10").ClearContents
        End If
        On Error GoTo 0 ' エラーハンドリングをリセット
        
        ' List of cells to copy and translate
        Dim cellList As Variant
        cellList = Array("J6", "J10", "J33", "J34", "J50", "AI47", "AI50", "J53", "AI53", "J56", "AI56", "P59", "AI59", "J62", "J65", "J67", "AI57", "P60", "AI57", "J57", "AI54", "J54", "AI45", "J51", "J48", "J45", "AI42", "J72", "J74", "AI74")
        
        ' Copy values from source to target sheet and translate if necessary
        For Each cell In cellList
            If Not IsEmpty(wsSource.Range(cell).Value) Then
                wsTarget.Range(cell).Value = TranslateText(wsSource.Range(cell).Value, apiKey)
            End If
        Next cell
    Else
        MsgBox "The target sheet could not be found or created.", vbCritical
    End If
    
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

Function TranslateText(text As String, apiKey As String) As String
    If Len(text) = 0 Then
        TranslateText = ""
        Exit Function
    End If
    
    Dim http As Object
    Dim url As String
    Dim response As String
    Dim json As Object
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    url = "https://translation.googleapis.com/language/translate/v2?key=" & apiKey & "&q=" & URLEncode(text) & "&source=ja&target=en"
    
    http.Open "GET", url, False
    http.send
    
    If http.Status <> 200 Then
        TranslateText = "Error: " & http.Status & " - " & http.statusText
        Exit Function
    End If
    
    response = http.responseText
    Set json = JsonConverter.ParseJson(response)
    
    TranslateText = json("data")("translations")(1)("translatedText")
End Function

Private Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
    Dim StringLen As Long: StringLen = Len(StringVal)
    If StringLen > 0 Then
        ReDim result(StringLen) As String
        Dim i As Long, CharCode As Integer
        Dim Char As String
        If SpaceAsPlus Then Space = "+" Else Space = "%20"
        For i = 1 To StringLen
            Char = Mid(StringVal, i, 1)
            CharCode = Asc(Char)
            Select Case CharCode
                Case 48 To 57, 65 To 90, 97 To 122
                    result(i) = Char
                Case 32
                    result(i) = Space
                Case 0 To 15
                    result(i) = "%0" & Hex(CharCode)
                Case Else
                    result(i) = "%" & Hex(CharCode)
            End Select
        Next i
        URLEncode = Join(result, "")
    End If
End Function

APIをセットし、フォーム名と cellListに翻訳したいセルを入力していけば、Excelデータの翻訳がでけるかと思います。

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