【ボタン１つ】DeepLでExcelを翻訳する｜VBAマクロファイルダウンロード

2023年7月7日2023年7月30日

当ページのリンクの一部に広告が含まれています。

DeepLでExcel翻訳

1 ファイル 30.92 KB

ダウンロード

「日本語で書かれたExcelを翻訳したい」

自然な翻訳ができて便利なDeepLですが、Excelファイルの翻訳は非対応です。（2023年6月時点）

Excelのたくさんのシートの中のたくさんのセルを1つ1つ翻訳するのは面倒。

この記事では

ExcelのVBAマクロとDeepLのAPIを用いて、Excelを自動翻訳するVBAマクロを作成したので、解説していきます。
あわせて、【ボタン１つで DeepLでExcelを一括翻訳する】のExcelファイルを配布しています。

【ボタン１つでDeepLでExcelを一括翻訳する】を配布中。

以下のリンクよりダウンロードください。

DeepLでExcel翻訳

1 ファイル 30.92 KB

ダウンロード

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

DeepLでExcelを一括翻訳するVBAマクロファイルの使い方

ダウンロードできる【DeepLでExcelを一括翻訳する】VBAマクロファイルの使い方を解説します。

DeepLでExcelを翻訳するには、事前にDeepL APIを設定する必要があります。

DeepLでExcelを一括翻訳するVBAマクロファイルの使い方

DeepL APIキーの設定
一括翻訳の実施

DeepL APIキーの設定

DeepLのAPIキーを取得してください。

取得したDeepLのAPIキーをマクロファイルのセルに入力してください。

一括翻訳の実施

マクロファイルのボタンを押します。

ダイアログから翻訳したいExcelを選択します。

VBAマクロが実行され、翻訳されたシートが追加されます。

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

DeepLのAPIキーを取得方法

ExcelのVBAマクロでDeepLを使用するには、DeepLのAPIキーが必要です。

DeepLのAPIキーの取得方法は以下の記事をご参照ください。

DeepL API を使ってみる – Qiita

DeepLのAPIには、無料版DeepL API Free と有料版DeepL API Proの2種類あります。2023年6月時点。

DeepL API

DeepL API Freeの特徴

1ヶ月あたり500,000文字の上限あり
法人向けレベルのデータセキュリティなし

DeepL API Proの特徴

万全のセキュリティ対策（テキストは翻訳後すぐに削除）
1か月に翻訳できる文字数に制限なし
翻訳リクエストを優先的に処理
1か月の基本料金630円 + ご利用文字数分の料金（1文字あたり0.0025円）

無料版には、法人向けレベルのデータセキュリティがないため、機密文書や社内費の文書の翻訳には向いていないので、ご注意ください。

また、無料版のアカウントの登録にもクレジットカードの登録が必要です。（プラン変更しない限り料金はかからないので安心してください）2023年6月時点

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

DeepLのAPIを使ってExcelを翻訳する方法の解説

DeepLのAPIを使ってExcelを翻訳するには、大きく2つのコードを利用します。

【行いたい処理を行うコード】と【VBA関数】を組み合わせて利用してください。

DeepLのAPIを使ってExcelを翻訳する方法の解説

Excelへの処理を行うVBAコード
DeepLのAPIキーを使って翻訳を行うVBA関数

Excelへの処理を行うVBAコード

今回は、Excelの処理を4種類コードを作成しました。

Excelへの処理を行うVBAコード

選択したExcelのすべてのシートを翻訳
アクティブなセルを翻訳
アクティブなシートを翻訳して新規シートとして保存
アクティブなセルを翻訳して該当するセルに反映

選択したExcelに存在するすべてのシートを翻訳するマクロです。

ボタンでマクロを実行し、ダイアログで翻訳したいExcelブックを選択してください。

アクティブなセルを翻訳して、翻訳結果というシートに記述していくマクロです。

翻訳したいセルを選択した状態で、リボンからマクロを実行してください。

アクティブなシートを翻訳して、翻訳結果を新規のシートとして保存するマクロです。

翻訳したいシートを選択した状態で、リボンからマクロを実行してください。

アクティブなセルを翻訳して、翻訳結果をセルに入力しているシートのアクティブなセルと同一の位置のセルに記述するマクロです。

翻訳結果を反映したいExcelをExcelブックに記述した上で、翻訳したいセルを選択した状態で、リボンからマクロを実行してください。

DeepLのAPIキーを使って翻訳を行うVBA関数

DeepL翻訳APIを使用して、指定した文を翻訳するVBA関数を定義します。

VBA関数は、DeepLのAPIの料金プランと翻訳対象言語によってコードが変わるので、設定環境に応じたコードを利用してください。

DeepLのAPIは無料版と有料版でリクエストするサブドメインが異なります。

利用している料金プランにあわせて、コードを修正してください。

翻訳対象の言語によって、APIのURLを作成する際のパラメーターが異なります。

英訳か和訳かで”source_lang”と”target_lang”したパラメータを変更してください。

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

DeepLのAPIキーを使ったVBA関数

DeepLのAPIキーを使ったVBA関数のコードを記載します。

【YOUR API KEY】に取得したDeepLのAPIキーを入力してください。

YOUR API KEY

‘DeepLで取得したkey

Dim APIkey As String

APIkey = ThisWorkbook.Sheets(“Sheet1”).Range(“C5”).Value

‘DeepLで取得したkey

Const APIkey As String = “YOUR API KEY”

無料版を利用する場合は【api-free.deepl.com】を、有料版を利用する場合は【api.deepl.com】のサブドメインを利用してください。

api-free.deepl.com

	api.deepl.com

DeepLのAPIを使ってExcelを英訳するVBA関数

下記の関数はDeepL翻訳APIを使用して、指定した文を翻訳するものです。関数に渡された日本語の文を英語に翻訳し、その結果を返します。

この関数は以下のExcel VBAマクロの処理に共通で使用しています。

無料版を利用する場合は【api-free.deepl.com】のサブドメインをリクエストしてください。

Function getTranslationEN(ByVal SourceSentence As String) As String
    'DeepLで取得したkey
    Const APIkey As String = "YOUR API KEY"
     
    '日本語の場合を考慮してUTF-8にエンコードする
    SourceSentence = WorksheetFunction.EncodeURL(SourceSentence)
     
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    With http
        'HTTPリクエスト（POSTメソッド）
        Call .Open("POST", "https://api-free.deepl.com/v2/translate?text=" & SourceSentence & "&source_lang=JA&target_lang=EN", False)
        Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & APIkey)
        Call .send
         
        'HTTPレスポンスの内容確認
        Dim buf As Variant
        Dim TranslatedSentence As String
         
        buf = Split(http.responseText, """")
        ' 翻訳結果内の "\n" を改行に置換
        TranslatedSentence = Replace(buf(9), "\n", vbCrLf)
        getTranslationEN = TranslatedSentence
    End With
End Function

Function getTranslationEN(ByVal SourceSentence As String) As String
    'DeepLで取得したkey
    Dim APIkey As String
    APIkey = ThisWorkbook.Sheets("Sheet1").Range("C5").Value
     
    '日本語の場合を考慮してUTF-8にエンコードする
    SourceSentence = WorksheetFunction.EncodeURL(SourceSentence)
     
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    With http
        'HTTPリクエスト（POSTメソッド）
        Call .Open("POST", "https://api-free.deepl.com/v2/translate?text=" & SourceSentence & "&source_lang=JA&target_lang=EN", False)
        Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & APIkey)
        Call .send
         
        'HTTPレスポンスの内容確認
        Dim buf As Variant
        Dim TranslatedSentence As String
         
        buf = Split(http.responseText, """")
        ' 翻訳結果内の "\n" を改行に置換
        TranslatedSentence = Replace(buf(9), "\n", vbCrLf)
        getTranslationEN = TranslatedSentence
    End With
End Function

有料版を利用する場合は【api.deepl.com】のサブドメインをリクエストしてください。

Function getTranslationEN(ByVal SourceSentence As String) As String
    'DeepLで取得したkey
    Const APIkey As String = "YOUR API KEY"
     
    '日本語の場合を考慮してUTF-8にエンコードする
    SourceSentence = WorksheetFunction.EncodeURL(SourceSentence)
     
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    With http
        'HTTPリクエスト（POSTメソッド）
        Call .Open("POST", "https://api.deepl.com/v2/translate?text=" & SourceSentence & "&source_lang=JA&target_lang=EN", False)
        Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & APIkey)
        Call .send
         
        'HTTPレスポンスの内容確認
        Dim buf As Variant
        Dim TranslatedSentence As String
         
        buf = Split(http.responseText, """")
        ' 翻訳結果内の "\n" を改行に置換
        TranslatedSentence = Replace(buf(9), "\n", vbCrLf)
        getTranslationEN = TranslatedSentence
    End With
End Function

DeepLのAPIを使ってExcelを和訳するVBA関数

下記の関数はDeepL翻訳APIを使用して、指定した文を翻訳するものです。関数に渡された英語の文を日本語に翻訳し、その結果を返します。

この関数は以下のExcel VBAマクロの処理に共通で使用しています。

無料版を利用する場合は【api-free.deepl.com】のサブドメインをリクエストしてください。

Function getTranslationJA(ByVal SourceSentence As String) As String
    'DeepLで取得したkey
    Const APIkey As String = "YOUR API KEY"
     
    'Englishを考慮してUTF-8にエンコードする
    SourceSentence = WorksheetFunction.EncodeURL(SourceSentence)
     
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    With http
        'HTTPリクエスト（POSTメソッド）
        Call .Open("POST", "https://api-free.deepl.com/v2/translate?text=" & SourceSentence & "&source_lang=EN&target_lang=JA", False)
        Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & APIkey)
        Call .send
         
        'HTTPレスポンスの内容確認
        Dim buf As Variant
        Dim TranslatedSentence As String
         
        buf = Split(http.responseText, """")
        ' 翻訳結果内の "\n" を改行に置換
        TranslatedSentence = Replace(buf(9), "\n", vbCrLf)
        getTranslationJA = TranslatedSentence
    End With
End Function

Function getTranslationJA(ByVal SourceSentence As String) As String
    'DeepLで取得したkey
    Dim APIkey As String
    APIkey = ThisWorkbook.Sheets("Sheet1").Range("C5").Value
     
    'Englishを考慮してUTF-8にエンコードする
    SourceSentence = WorksheetFunction.EncodeURL(SourceSentence)
     
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    With http
        'HTTPリクエスト（POSTメソッド）
        Call .Open("POST", "https://api-free.deepl.com/v2/translate?text=" & SourceSentence & "&source_lang=EN&target_lang=JA", False)
        Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & APIkey)
        Call .send
         
        'HTTPレスポンスの内容確認
        Dim buf As Variant
        Dim TranslatedSentence As String
         
        buf = Split(http.responseText, """")
        ' 翻訳結果内の "\n" を改行に置換
        TranslatedSentence = Replace(buf(9), "\n", vbCrLf)
        getTranslationJA = TranslatedSentence
    End With
End Function

有料版を利用する場合は【api.deepl.com】のサブドメインをリクエストしてください。

Function getTranslationJA(ByVal SourceSentence As String) As String
    'DeepLで取得したkey
    Const APIkey As String = "YOUR API KEY"
     
    'Englishを考慮してUTF-8にエンコードする
    SourceSentence = WorksheetFunction.EncodeURL(SourceSentence)
     
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    With http
        'HTTPリクエスト（POSTメソッド）
        Call .Open("POST", "https://api.deepl.com/v2/translate?text=" & SourceSentence & "&source_lang=EN&target_lang=JA", False)
        Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & APIkey)
        Call .send
         
        'HTTPレスポンスの内容確認
        Dim buf As Variant
        Dim TranslatedSentence As String
         
        buf = Split(http.responseText, """")
        ' 翻訳結果内の "\n" を改行に置換
        TranslatedSentence = Replace(buf(9), "\n", vbCrLf)
        getTranslationJA = TranslatedSentence
    End With
End Function

注意点

DeepL APIは無料版の場合、利用可能なリクエスト数に制限があるため、大量のデータを一度に処理すると、その制限を超える可能性があります。その場合は有料版を検討するか、処理を分割するなどの対策が必要です。
この関数は翻訳を実行するための関数で、DeepL APIに依存します。そのため、その処理速度はDeepL APIのパフォーマンスに依存します。
また、DeepL APIに通信エラーやDeepL API自体のエラー等が発生する可能性がありますので、その点も考慮してください。

各コードの解説

DeepL APIを利用するために必要な認証キーを定義します。

    'DeepLで取得したkey
    Const APIkey As String = "YOUR API KEY"

元のテキストをURLエンコードします。APIにリクエストを送る際に、テキストの内容がURLパラメータとして適切にエンコードされるようにします。

    '日本語の場合を考慮してUTF-8にエンコードする
    SourceSentence = WorksheetFunction.EncodeURL(SourceSentence)

MSXML2.XMLHTTPを使用してHTTPリクエストオブジェクトを作成します。

    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")

DeepL APIへのHTTPリクエストを設定し、送信します。POSTメソッドを使用し、リクエストヘッダーに認証キーを設定します。

    With http
        'HTTPリクエスト（POSTメソッド）
        Call .Open("POST", "https://api-free.deepl.com/v2/translate?text=" & SourceSentence & "&source_lang=JA&target_lang=EN", False)
        Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & APIkey)
        Call .send

HTTPレスポンスの内容を確認し、翻訳結果を取得します。レスポンステキストはJSON形式なので、ダブルクォーテーションで分割し、翻訳結果を取得します。翻訳結果内の “\n” を改行に置換します。

        'HTTPレスポンスの内容確認
        Dim buf As Variant
        Dim TranslatedSentence As String
         
        buf = Split(http.responseText, """")
        
        ' 翻訳結果内の "\n" を改行に置換
        TranslatedSentence = Replace(buf(9), "\n", vbCrLf)
        getTranslation = TranslatedSentence

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

選択したExcelのすべてのシートを翻訳

このマクロはダイアログで選択したExcelワークブックの各ワークシート内のすべてのセルを翻訳するものです。

原文を含む新しいワークシートが各ワークシートごとに作成され、翻訳結果がその新しいワークシートに書き込まれます。

Sub 選択したブックの全てのシートを翻訳()

    ' 変数定義
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim SourceSentence As String
    Dim TranslatedSentence As String
    
    ' ダイアログを通じてユーザーにワークブックを選択させる
    Dim dialogBox As FileDialog
    Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
    
    With dialogBox
        .Title = "ワークブックを選択してください"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb"
        
        If .Show = -1 Then
            Set wbSource = Application.Workbooks.Open(.SelectedItems(1))
        Else
            MsgBox "ワークブックが選択されませんでした。処理を終了します。"
            Exit Sub
        End If
    End With

    ' スクリーン更新と自動計算をオフにして処理を速くする
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' エラーハンドリングの開始
    On Error GoTo ErrorHandler

    ' 選択されたワークブック内の各ワークシートを処理
    For Each wsSource In wbSource.Worksheets
        wsSource.Copy After:=wsSource
        Set wsTarget = ActiveSheet
        wsTarget.Name = wsSource.Name & "EN"

        Set rng = wsSource.UsedRange

        For Each cell In rng
            If Not IsEmpty(cell) Then
                SourceSentence = cell.Value
                TranslatedSentence = getTranslation(SourceSentence)
                wsTarget.Range(cell.Address).Value = TranslatedSentence
            End If
        Next cell
    Next wsSource

    ' ワークブックを保存
    wbSource.Save

    ' スクリーン更新と自動計算を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "処理が完了しました。", vbInformation

    Exit Sub

ErrorHandler:
    ' エラーが発生した場合はメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical

    ' スクリーン更新と自動計算を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

このマクロは選択されたワークブック内の全てのセルを翻訳します。そのため、セル数が非常に多い場合や、翻訳する文が非常に長い場合など、翻訳する内容の量が大きい場合、処理に時間がかかる可能性があります。

翻訳API（この場合はgetTranslation関数内で利用されるAPI）の利用制限がある場合、その制限を超える可能性があります。制限を超えると、それ以上の翻訳ができなくなるため注意が必要です。

また、原文のワークシートと同じ名称に”EN”を追加した新しいワークシートを作成しますが、既に同じ名称のワークシートが存在する場合、エラーが発生します。そのため、事前に同じ名称のワークシートが存在しないか確認が必要です。

英語に翻訳します。

Sub TranslateToEnglish()

    ' 変数定義
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim SourceSentence As String
    Dim TranslatedSentence As String
    
    ' ダイアログを通じてユーザーにワークブックを選択させる
    Dim dialogBox As FileDialog
    Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
    
    With dialogBox
        .Title = "ワークブックを選択してください"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb"
        
        If .Show = -1 Then
            Set wbSource = Application.Workbooks.Open(.SelectedItems(1))
        Else
            MsgBox "ワークブックが選択されませんでした。処理を終了します。"
            Exit Sub
        End If
    End With

    ' スクリーン更新と自動計算をオフにして処理を速くする
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' エラーハンドリングの開始
    On Error GoTo ErrorHandler

    ' 選択されたワークブック内の各ワークシートを処理
    For Each wsSource In wbSource.Worksheets
        ' If the worksheet name contains "EN", skip this worksheet
        If InStr(1, wsSource.Name, "EN", vbTextCompare) > 0 Then
            GoTo NextWorksheet
        End If

        wsSource.Copy After:=wsSource

        Dim newSheetName As String
        Dim i As Integer
        i = 1
        newSheetName = wsSource.Name & "EN"
        
        ' シート名が既に存在する場合、番号を追加する
        While Evaluate("ISREF('" & newSheetName & "'!A1)")
            i = i + 1
            newSheetName = wsSource.Name & "EN" & CStr(i)
        Wend
        
        Set wsTarget = ActiveSheet
        wsTarget.Name = newSheetName

        Set rng = wsSource.UsedRange

        For Each cell In rng
            If Not IsEmpty(cell) Then
                SourceSentence = cell.Value
                TranslatedSentence = getTranslationEN(SourceSentence)
                wsTarget.Range(cell.Address).Value = TranslatedSentence
            End If
        Next cell

NextWorksheet:
    Next wsSource

    ' ワークブックを保存
    wbSource.Save

    ' スクリーン更新と自動計算を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "処理が完了しました。", vbInformation

    Exit Sub

ErrorHandler:
    ' エラーが発生した場合はメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical

    ' スクリーン更新と自動計算を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

日本語に翻訳します。

Sub TranslateToJapanese()

    ' 変数定義
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim SourceSentence As String
    Dim TranslatedSentence As String
    
    ' ダイアログを通じてユーザーにワークブックを選択させる
    Dim dialogBox As FileDialog
    Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
    
    With dialogBox
        .Title = "ワークブックを選択してください"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb"
        
        If .Show = -1 Then
            Set wbSource = Application.Workbooks.Open(.SelectedItems(1))
        Else
            MsgBox "ワークブックが選択されませんでした。処理を終了します。"
            Exit Sub
        End If
    End With

    ' スクリーン更新と自動計算をオフにして処理を速くする
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' エラーハンドリングの開始
    On Error GoTo ErrorHandler

    ' 選択されたワークブック内の各ワークシートを処理
    For Each wsSource In wbSource.Worksheets
        ' If the worksheet name contains "JA", skip this worksheet
        If InStr(1, wsSource.Name, "JA", vbTextCompare) > 0 Then
            GoTo NextWorksheet
        End If

        wsSource.Copy After:=wsSource

        Dim newSheetName As String
        Dim i As Integer
        i = 1
        newSheetName = wsSource.Name & "JA"
        
        ' シート名が既に存在する場合、番号を追加する
        While Evaluate("ISREF('" & newSheetName & "'!A1)")
            i = i + 1
            newSheetName = wsSource.Name & "JA" & CStr(i)
        Wend
        
        Set wsTarget = ActiveSheet
        wsTarget.Name = newSheetName

        Set rng = wsSource.UsedRange

        For Each cell In rng
            If Not IsEmpty(cell) Then
                SourceSentence = cell.Value
                TranslatedSentence = getTranslationJA(SourceSentence)
                wsTarget.Range(cell.Address).Value = TranslatedSentence
            End If
        Next cell

NextWorksheet:
    Next wsSource

    ' ワークブックを保存
    wbSource.Save

    ' スクリーン更新と自動計算を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "処理が完了しました。", vbInformation

    Exit Sub

ErrorHandler:
    ' エラーが発生した場合はメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical

    ' スクリーン更新と自動計算を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

各コードの解説

以下に処理ごとにコードを解説していきます。

ファイルダイアログを表示し、ユーザーにExcelワークブックの選択を促します。選択されたワークブックは後続の処理の対象となります。

   ' ダイアログを通じてユーザーにワークブックを選択させる
    Dim dialogBox As FileDialog
    Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
    
    With dialogBox
        .Title = "ワークブックを選択してください"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb"
        
        If .Show = -1 Then
            Set wbSource = Application.Workbooks.Open(.SelectedItems(1))
        Else
            MsgBox "ワークブックが選択されませんでした。処理を終了します。"
            Exit Sub
        End If
    End With

スクリーン更新をオフにし、自動計算を手動に設定します。これにより、Excelの処理が高速化されます。

    ' スクリーン更新と自動計算をオフにして処理を速くする
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

ワークブック内の各ワークシートについて、それぞれ新しいワークシートを作成し、その新しいワークシート内の各セルについて翻訳処理を行います。

   ' 選択されたワークブック内の各ワークシートを処理
    For Each wsSource In wbSource.Worksheets
        wsSource.Copy After:=wsSource
        Set wsTarget = ActiveSheet
        wsTarget.Name = wsSource.Name & "EN"

        Set rng = wsSource.UsedRange

        For Each cell In rng
            If Not IsEmpty(cell) Then
                SourceSentence = cell.Value
                TranslatedSentence = getTranslation(SourceSentence)
                wsTarget.Range(cell.Address).Value = TranslatedSentence
            End If
        Next cell
    Next wsSource

各セルの内容を翻訳し、翻訳結果を新しいワークシートの対応するセルに書き込みます。

                SourceSentence = cell.Value
                TranslatedSentence = getTranslation(SourceSentence)
                wsTarget.Range(cell.Address).Value = TranslatedSentence

翻訳後のワークブックを保存します。

    ' ワークブックを保存
    wbSource.Save

スクリーン更新をオンに戻し、自動計算を再度自動に設定します。

   ' スクリーン更新と自動計算を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

アクティブなセルを翻訳

このコードは、アクティブなセルの内容を翻訳し、「翻訳結果」という名前のワークシートに翻訳結果を追加するVBAマクロです。

「本肉結果」というシートに既存のデータがある場合、新たな翻訳結果が追記されます。

Sub アクティブなセルを翻訳()

    ' 元のテキストと翻訳結果の変数定義
    Dim SourceSentence As String
    Dim TranslatedSentence As String

    ' アクティブセルの内容を元のテキストとして設定
    SourceSentence = ActiveCell.Value

    ' 元のテキストを翻訳
    TranslatedSentence = getTranslation(SourceSentence)

    Dim ws As Worksheet

    ' "翻訳結果"のシートが存在するか確認し、存在しない場合は新規作成
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("翻訳結果")
    On Error GoTo ErrorHandler

    ' "翻訳結果"のシートが存在しない場合は新規作成
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.Name = "翻訳結果"
    End If

    ' "翻訳結果"のシートに翻訳結果を追記
    ws.Cells(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1, 1) = TranslatedSentence

    ' 完了メッセージを表示
    MsgBox "完了しました。", vbInformation

    Exit Sub

ErrorHandler:
    ' エラーが発生した場合はメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical

End Sub

注意点

シート内に大量のデータが存在する場合や、大量の翻訳が必要な場合、処理には時間がかかります。ご注意ください。
DeepLのAPIには使用上限があります。
getTranslation関数は、翻訳を実行するための関数で、外部のDeepLのAPI等に依存します。そのため、その処理速度はDeepLのAPIのパフォーマンスに依存します。
また、DeepLのAPIには通信エラーやDeepLのAPI自体のエラー等が発生する可能性がありますので、その点も考慮してください。

各コードの解説

以下の処理ごとにコードを解説していきます。

アクティブセルの内容を保存し、翻訳結果を保存するための変数を定義します。

    ' 元のテキストと翻訳結果の変数定義
    Dim SourceSentence As String
    Dim TranslatedSentence As String

現在アクティブなセルの内容を元のテキストとして保存します。

    ' アクティブセルの内容を元のテキストとして設定
    SourceSentence = ActiveCell.Value

元のテキストを翻訳します。ここでのgetTranslationは翻訳を行う外部関数とします。

    ' 元のテキストを翻訳
    TranslatedSentence = getTranslation(SourceSentence)

翻訳結果を格納するWorksheetオブジェクトを定義します。

    Dim ws As Worksheet

“翻訳結果”という名前のシートが存在するか確認します。存在しない場合は新規に作成します。

    ' "翻訳結果"のシートが存在するか確認し、存在しない場合は新規作成
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("翻訳結果")
    On Error GoTo ErrorHandler

    ' "翻訳結果"のシートが存在しない場合は新規作成
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.Name = "翻訳結果"
    End If

“翻訳結果”シートの最後の行に翻訳結果を追記します。

    ' "翻訳結果"のシートに翻訳結果を追記
    ws.Cells(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1, 1) = TranslatedSentence

処理が終了したことを通知するメッセージを表示します。

    ' 完了メッセージを表示
    MsgBox "完了しました。", vbInformation

エラーが発生した場合の処理を記述します。エラーの詳細をメッセージボックスに表示します。

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

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

アクティブなシートを翻訳して新規シートとして保存

Sub アクティブなシート全体を翻訳して新規シートを作成()

    ' 元のシートと翻訳シートの変数定義
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim SourceSentence As String
    Dim TranslatedSentence As String

    ' アクティブシートを元のシートとして設定
    Set wsSource = ActiveSheet

    ' エラーハンドリング開始
    On Error GoTo ErrorHandler

    ' 元のシートをコピーして新規シートを作成、名前を元のシート名 + "-EN"に設定
    wsSource.Copy After:=wsSource
    Set wsTarget = ActiveSheet
    wsTarget.Name = wsSource.Name & "-EN"

    ' 元のシートの使用範囲を設定
    Set rng = wsSource.UsedRange

    ' 全てのセルをループして翻訳、結果を新規シートに記入
    For Each cell In rng
        If Not IsEmpty(cell) Then
            SourceSentence = cell.Value
            TranslatedSentence = getTranslation(SourceSentence)
            wsTarget.Range(cell.Address).Value = TranslatedSentence
        End If
    Next cell

    ' 完了メッセージを表示
    MsgBox "翻訳が完了しました。", vbInformation

    ' 正常終了
    Exit Sub

ErrorHandler:
    ' エラーが発生した場合はメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical

End Sub

注意点

DeepLのAPIの具体的な機能やレートリミット（一定時間内のリクエスト数の上限）は getTranslation 関数の実装に依存します。大量のデータを処理する際にはこの点を考慮してください。
シートのセル数が多いと、翻訳処理に時間がかかる可能性があります。また、Excelのセルの最大数（約1,000万セル）を超えないように注意してください。

各コードの解説

以下に処理ごとにコードを解説していきます。

アクティブシートを元のシートとして設定します。

Set wsSource = ActiveSheet

元のシートをコピーして新規シートを作成し、その名前を元のシート名 + “-EN”に設定します。

wsSource.Copy After:=wsSourceSet wsTarget = ActiveSheetwsTarget.Name = wsSource.Name & "-EN"

元のシートの全てのセルをループして翻訳し、その結果を新規シートに記入します。

For Each cell In rngIf Not IsEmpty(cell) ThenSourceSentence = cell.ValueTranslatedSentence = getTranslation(SourceSentence)wsTarget.Range(cell.Address).Value = TranslatedSentenceEnd IfNext cell

処理が正常に完了した場合、完了メッセージを表示します。

MsgBox "翻訳が完了しました。", vbInformation

エラーが発生した場合、エラーメッセージを表示します。

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

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

アクティブなセルを翻訳して該当するセルに反映

Sub アクティブなセルを翻訳してシートの該当箇所に反映()

    ' 変数定義
    Dim SourceCell As Range
    Dim TargetCell As Range
    Dim SourceSentence As String
    Dim TranslatedSentence As String
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet

    ' エラーハンドリング開始
    On Error GoTo ErrorHandler

    ' 翻訳元のアクティブセルを取得
    Set SourceCell = ActiveCell
    SourceSentence = SourceCell.Value
    
    ' 翻訳先のWorkbookとWorksheetを指定
    Set wbTarget = Workbooks.Open(ThisWorkbook.Sheets("Sheet1").Range("C6").Value)
    Set wsTarget = wbTarget.Worksheets(ThisWorkbook.Sheets("Sheet1").Range("C7").Value)

    ' 翻訳先のセルを設定
    Set TargetCell = wsTarget.Cells(SourceCell.Row, SourceCell.Column)

    ' 翻訳と結果をターゲットセルに入力
    TranslatedSentence = getTranslation(SourceSentence)
    TargetCell.Value = TranslatedSentence
    
    ' 翻訳対象ファイルを保存して閉じる
    wbTarget.Save
    wbTarget.Close

    ' 完了メッセージを表示
    MsgBox "翻訳が完了しました。", vbInformation

    ' 正常終了
    Exit Sub

ErrorHandler:
    ' エラーが発生した場合はメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical

End Sub

注意点

DeepLのAPIの具体的な機能やレートリミット（一定時間内のリクエスト数の上限）は getTranslation 関数の実装に依存します。大量のデータを処理する際にはこの点を考慮してください。
アクティブセルの内容が大量のテキストである場合、処理に時間がかかる可能性があります。

各コードの解説

以下の処理ごとにコードを解説していきます。

必要な変数を定義します。これには、翻訳元と翻訳先のセル、翻訳元の文章、翻訳された文章、翻訳先のワークブックとワークシートが含まれます。

    ' 変数定義
    Dim SourceCell As Range
    Dim TargetCell As Range
    Dim SourceSentence As String
    Dim TranslatedSentence As String
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet

ここからエラーハンドリングを開始します。これにより、エラーが発生した場合でも適切に処理を行うことができます。

    ' エラーハンドリング開始
    On Error GoTo ErrorHandler

翻訳するセルとしてアクティブなセル（選択中のセル）を取得します。

    ' 翻訳元のアクティブセルを取得
    Set SourceCell = ActiveCell
    SourceSentence = SourceCell.Value

翻訳先のワークブックとワークシートを指定します。この例では、「Sheet1」の「C6」セルにワークブックのパスが、「C7」セルにワークシートの名前が記載されていると仮定しています。

     ' 翻訳先のWorkbookとWorksheetを指定
    Set wbTarget = Workbooks.Open(ThisWorkbook.Sheets("Sheet1").Range("C6").Value)
    Set wsTarget = wbTarget.Worksheets(ThisWorkbook.Sheets("Sheet1").Range("C7").Value)

翻訳先のセルを設定します。この例では、翻訳元のセルと同じ行と列のセルを翻訳先としています。

    ' 翻訳先のセルを設定
    Set TargetCell = wsTarget.Cells(SourceCell.Row, SourceCell.Column)

翻訳処理を行い、その結果を翻訳先のセルに入力します。

    ' 翻訳と結果をターゲットセルに入力
    TranslatedSentence = getTranslation(SourceSentence)
    TargetCell.Value = TranslatedSentence

翻訳対象のファイル（ワークブック）を保存し、閉じます。

    ' 翻訳対象ファイルを保存して閉じる
    wbTarget.Save
    wbTarget.Close

翻訳が完了したことをユーザーに通知するメッセージを表示します。

    ' 完了メッセージを表示
    MsgBox "翻訳が完了しました。", vbInformation

エラーハンドリングの終了位置を指定します。これはエラーが発生しなかった場合に適用されます。

    ' 正常終了
    Exit Sub

エラーが発生した場合の処理を記述します。この例では、エラーの詳細を表示します。

ErrorHandler:
    ' エラーが発生した場合はメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical

TOEIC L & R TEST 出る単特急金のフレーズ (TOEIC TEST 特急シリーズ)

朝日新聞出版

➢ Amazonのレビューを見る

まとめ：DeepL APIを使って、Excelを一括翻訳

DeepLでExcel翻訳

1 ファイル 30.92 KB

ダウンロード

DeepL APIとExcel VBAのマクロを使って、Excelを一括翻訳する方法でした。

APIを設定するのが面倒な方は、Google翻訳を利用してください。

【ボタン１つ】DeepLでExcelを翻訳する｜VBAマクロファイルダウンロード

DeepLでExcel翻訳

DeepLでExcel翻訳

DeepLでExcelを一括翻訳するVBAマクロファイルの使い方

DeepL APIキーの設定

一括翻訳の実施

DeepLのAPIキーを取得方法

DeepLのAPIを使ってExcelを翻訳する方法の解説

Excelへの処理を行うVBAコード

DeepLのAPIキーを使って翻訳を行うVBA関数

DeepLのAPIキーを使ったVBA関数

DeepLのAPIを使ってExcelを英訳するVBA関数

DeepLのAPIを使ってExcelを和訳するVBA関数

各コードの解説

選択したExcelのすべてのシートを翻訳

各コードの解説

アクティブなセルを翻訳

各コードの解説

アクティブなシートを翻訳して新規シートとして保存

各コードの解説

アクティブなセルを翻訳して該当するセルに反映

各コードの解説

まとめ：DeepL APIを使って、Excelを一括翻訳

DeepLでExcel翻訳

コメント

コメントするコメントをキャンセル

【ボタン１つ】DeepLでExcelを翻訳する｜VBAマクロファイルダウンロード

DeepLでExcel翻訳

DeepLでExcel翻訳

DeepLでExcelを一括翻訳するVBAマクロファイルの使い方

DeepL APIキーの設定

一括翻訳の実施

DeepLのAPIキーを取得方法

DeepLのAPIを使ってExcelを翻訳する方法の解説

Excelへの処理を行うVBAコード

DeepLのAPIキーを使って翻訳を行うVBA関数

DeepLのAPIキーを使ったVBA関数

DeepLのAPIを使ってExcelを英訳するVBA関数

DeepLのAPIを使ってExcelを和訳するVBA関数

各コードの解説

選択したExcelのすべてのシートを翻訳

各コードの解説

アクティブなセルを翻訳

各コードの解説

アクティブなシートを翻訳して新規シートとして保存

各コードの解説

アクティブなセルを翻訳して該当するセルに反映

各コードの解説

まとめ：DeepL APIを使って、Excelを一括翻訳

DeepLでExcel翻訳

コメント

コメントする コメントをキャンセル

コメントするコメントをキャンセル