業務効率化

VBA:テキスト翻訳関数(GAS/GoogleCloudAPI/AzureAPI対応)

エクセルVBAによる翻訳関数のマクロです。GoogleAppsScript・GoogleCloud翻訳APIによるGoogle翻訳とAzureAI翻訳のいずれかを使用できます。

対象文字列を指定し、第二引数に言語を指定することで翻訳ができます。第二引数はオプショナルとしており、もし第二引数がない場合は自動和英訳されます。

2026年時点ではCopilot365のプランにて、Translate関数やCopilot編集モードで公式の機能で翻訳が可能になりました。今関数は、プラン加入していない方、他のマクロ等で翻訳機能組み込み時に活用できます。

今後はCopilot関数が導入だとかWhat's New in Excel (June 2025) | Microsoft Community Hub

記事の内容

・コード

・ポイント機能

・コード

翻訳関数はこのサイトでのマクロを参考にさせていただきました。

VBA翻訳関数（GAS・GoogleCloudAPI・Azure翻訳API）ダウンロード

APIKey等があればダウンロードしシート上の指定箇所に記載することですぐ利用可能です。

2025年12月追記:
上記のHttp通信による無料Google翻訳利用は、同社同サービスの利用規約に違反する可能性があります。利用することは避け、従課金制GoogleやAzure翻訳サービス(50万~200万は無料)か、Google Apps Scriptによる翻訳（無料）を検討することをお勧めします。利用規約の考察は下記を参照ください。

➤Http通信による無料翻訳マクロ:あくまで参考用としてご覧ください 
Option Explicit

Public Function Gootrans_DefJPandEn(rng As Range, Optional translateFrom As String, Optional translateTo As String) As String
'Dim translateFrom As String, translateTo As String
                        
    '変数設定
    Dim param As String, trans As String, url As String
    
    'HTTPリクエストの設定
    Dim objHTTP As Object
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    
    'セルの値を取得
    param = rng.Value
    
    If translateFrom = "" Or translateTo = "" Then
    
    If IsJPTexts(param) Then
        translateFrom = "ja"
        translateTo = "en"
    Else
        translateFrom = "en"
        translateTo = "ja"
    End If
    
    End If
    
    
    
    'HTTPリクエストのURL設定
    url = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & EncodeURL(param)
    
    'HTTPリクエスト
    objHTTP.Open "GET", url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    'HTTPリクエストのレスポンステキストを取得
    Dim oHtml As New MSHTML.HTMLDocument
    Set oHtml = New MSHTML.HTMLDocument
    oHtml.body.innerHTML = objHTTP.responseText
    
    '翻訳結果を取得
    Dim transtext As String
    transtext = oHtml.getElementsByClassName("result-container")(0).innerText
    
    '翻訳結果があればClean関数を実行、なければエラー出力
    If transtext <> "" Then
        Gootrans_DefJPandEn = Clean(transtext)
    Else
        Gootrans_DefJPandEn = CVErr(xlErrValue)
    End If

End Function

'翻訳前のテキストのエンコード用に変換
Function ConvertToGet(str As String)

    str = Replace(str, " ", "+")
    str = Replace(str, vbNewLine, "+")
    str = Replace(str, "(", "%28")
    str = Replace(str, ")", "%29")
    
    ConvertToGet = str

End Function

'翻訳後のテキスト内の文言を変換
Function Clean(str As String)

    'str = Replace(str, """, """")
    str = Replace(str, "%2C", ",")
    str = Replace(str, "'", "'")
    
    Clean = str

End Function

'日本語をURLエンコード
Function EncodeURL(ByVal str As String) As String
    EncodeURL = Application.WorksheetFunction.EncodeURL(str)
End Function

'関数の説明
Sub RegisterGoogleTransleFormula()

    '関数名の設定
    Dim strFunc As String
    strFunc = "Gootrans_DefJpAndEn"
    
    '関数の説明
    Dim strDesc As String
    strDesc = "Gootrans_DefJpAndEn関数" & vbNewLine & vbNewLine & _
    "英語から日本語に翻訳したい場合、Gootrans_DefJpAndEn(A1,""en"",""ja"")" & vbNewLine & vbNewLine & _
    "日本語から英語に翻訳したい場合、Gootrans_DefJpAndEn(A1,""ja"",""en"")" & vbNewLine & vbNewLine & _
    "他の言語を使いたい場合は: https://cloud.google.com/translate/docs/languages/" & vbNewLine & "   "

    '関数内の引数の説明
    Dim strArgs(0 To 2) As String
    strArgs(0) = "翻訳したいセルを選択"
    strArgs(1) = "現在の言語を入力(ex. 英語はen,日本語はja)"
    strArgs(2) = "翻訳したい言語を入力(ex. 英語はen,日本語はja)他：中国語簡体:zh-CN, マレー語:ms,韓国語:ko"
    
    Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, Category:="Custom Category"

End Sub

Option Explicit

Public Function Gootrans_DefJPandEn(rng As Range, Optional translateFrom As String, Optional translateTo As String) As String
'Dim translateFrom As String, translateTo As String
                        
    '変数設定
    Dim param As String, trans As String, url As String
    
    'HTTPリクエストの設定
    Dim objHTTP As Object
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    
    'セルの値を取得
    param = rng.Value
    
    If translateFrom = "" Or translateTo = "" Then
    
     If IsJPTexts(param) Then
        translateFrom = "ja"
        translateTo = "en"
     Else
        translateFrom = "en"
        translateTo = "ja"
     End If

    Else
        LngToTranslateFrom = TranslateFrom
        LngToTranslateTo = TranslateTo
    
    End If
    
    
    
    'HTTPリクエストのURL設定
    url = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & EncodeURL(param)
    
    'HTTPリクエスト
    objHTTP.Open "GET", url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    'HTTPリクエストのレスポンステキストを取得
    Dim oHtml As New MSHTML.HTMLDocument
    Set oHtml = New MSHTML.HTMLDocument
    oHtml.body.innerHTML = objHTTP.responseText
    
    '翻訳結果を取得
    Dim transtext As String
    transtext = oHtml.getElementsByClassName("result-container")(0).innerText
    
    '翻訳結果があればClean関数を実行、なければエラー出力
    If transtext <> "" Then
        Gootrans_DefJPandEn = Clean(transtext)
    Else
        Gootrans_DefJPandEn = CVErr(xlErrValue)
    End If

End Function

'翻訳前のテキストのエンコード用に変換
Function ConvertToGet(str As String)

    str = Replace(str, " ", "+")
    str = Replace(str, vbNewLine, "+")
    str = Replace(str, "(", "%28")
    str = Replace(str, ")", "%29")
    
    ConvertToGet = str

End Function

'翻訳後のテキスト内の文言を変換
Function Clean(str As String)

    'str = Replace(str, """, """")
    str = Replace(str, "%2C", ",")
    str = Replace(str, "'", "'")
    str = UCase(Left(str, 1)) & Mid(str, 2)
    
    
    Clean = str

End Function

'日本語をURLエンコード
Function EncodeURL(ByVal str As String) As String
    EncodeURL = Application.WorksheetFunction.EncodeURL(str)
End Function

'関数の説明
Sub RegisterGoogleTransleFormula()

    '関数名の設定
    Dim strFunc As String
    strFunc = "Gootrans_DefJpAndEn"
    
    '関数の説明
    Dim strDesc As String
    strDesc = "Gootrans_DefJpAndEn関数" & vbNewLine & vbNewLine & _
    "英語から日本語に翻訳したい場合、Gootrans_DefJpAndEn(A1,""en"",""ja"")" & vbNewLine & vbNewLine & _
    "日本語から英語に翻訳したい場合、Gootrans_DefJpAndEn(A1,""ja"",""en"")" & vbNewLine & vbNewLine & _
    "他の言語を使いたい場合は: https://cloud.google.com/translate/docs/languages/" & vbNewLine & "   "

    '関数内の引数の説明
    Dim strArgs(0 To 2) As String
    strArgs(0) = "翻訳したいセルを選択"
    strArgs(1) = "現在の言語を入力(ex. 英語はen,日本語はja)"
    strArgs(2) = "翻訳したい言語を入力(ex. 英語はen,日本語はja)他：中国語簡体:zh-CN, マレー語:ms,韓国語:ko"
    
    Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, Category:="Custom Category"

End Sub

下記①，②スクリプトは、今記事で紹介する一括翻訳マクロで利用する関数として、JSON用の処理やエラー用のPublic変数が含まれています。不要な記述ですが、関数の未使用時でも問題ありません。

※下記3種を使用する際、共通変数や関数を記載しているこのスクリプトもセットでプロシージャに保存してください 
Option Explicit

Public objHTTP As Object
Public oHtml As Object

Public GAS_Status As String
Public GOOGLE_API_KEY As String

Public GgleAPIkey As String, GASurl As String
Public AzureAPIkey As String, AzureEndP As String, AzureReg As String



'========================================
' URLエンコード
'========================================
Public Function EncodeURL(ByVal str As String) As String
    EncodeURL = Application.WorksheetFunction.EncodeURL(str)
End Function

'========================================
' JSONエスケープ
'========================================
Public Function JsonEscape(ByVal s As String) As String
    s = Replace(s, "\", "\\")
    s = Replace(s, """", "\""")
    s = Replace(s, vbCrLf, "\n")
    s = Replace(s, vbCr, "\n")
    s = Replace(s, vbLf, "\n")
    s = Replace(s, vbTab, "\t")
    JsonEscape = s
End Function

'========================================
' 翻訳後整形
' capitalizeEnglish=True の場合は先頭大文字化
'========================================
Public Function CleanTranslatedText(ByVal str As String, Optional ByVal capitalizeEnglish As Boolean = True) As String
    str = Replace(str, "%2C", ",")
    str = Replace(str, "'", "'")

    If capitalizeEnglish Then
        If Len(str) > 0 Then
            str = UCase$(Left$(str, 1)) & Mid$(str, 2)
        End If
    End If

    CleanTranslatedText = str
End Function

'Http通信による戻り値の翻訳エラー判定
'リクエストサービスにより多少異なる場合あり
Public Function GetCommonHttpErrorMessage( _
    ByVal HttpStatus As Long, _
    Optional ByVal ProviderName As String = "", _
    Optional ByVal ParamText As String = "", _
    Optional ByVal ResponseText As String = "" _
) As String

    Dim msg As String

    Select Case HttpStatus
        Case 400
            msg = "400: リクエスト不正"
        Case 401
            msg = "401: 認証エラー"
        Case 403
            msg = "403: アクセス拒否 / キー不正 / 権限不足"
        Case 404
            msg = "404: URL誤り / エンドポイント不正"
        Case 408
            msg = "408: タイムアウト"
        Case 409
            msg = "409: 競合エラー"
        Case 413
            msg = "413: リクエストサイズ超過"
        Case 415
            msg = "415: Content-Type不正"
        Case 429
            msg = "429: 使いすぎ（時間をおいて再実行）"
        Case 500
            msg = "500: サーバー内部エラー"
        Case 502
            msg = "502: ゲートウェイエラー"
        Case 503
            msg = "503: サービス利用不可"
        Case 504
            msg = "504: ゲートウェイタイムアウト"
        Case Else
            msg = HttpStatus & ": HTTPエラー"
    End Select

    If ProviderName <> "" Then
        msg = "[" & ProviderName & "] " & msg
    End If

    If ParamText <> "" Then
        msg = msg & vbCrLf & "- " & ParamText
    End If

    If Trim$(ResponseText) <> "" Then
        msg = msg & vbCrLf & "Detail: " & Left$(ResponseText, 300)
    End If

    GetCommonHttpErrorMessage = "ErrOccured/エラーです。:" & vbCr & msg

End Function

Function IsJPTexts(inputText As Variant, JpDefRatio零点数値で記載 As String) As Boolean
    
    If JpDefRatio零点数値で記載 = "" Then
        JpDefRatio零点数値で記載 = "0.3"
    End If
    
    ' 日本語の文字をカウントする
    Dim japaneseCount As Integer
    japaneseCount = CountJapaneseCharacters(inputText)
    
    ' 文字列全体の長さを取得
    Dim totalLength As Integer
    totalLength = Len(inputText)
    
    ' 日本語の文字が引数指定分の数以上を占めているか確認
    If totalLength > 0 And (japaneseCount / totalLength) >= CDbl(JpDefRatio零点数値で記載) Then  '0.4 Then
        IsJPTexts = True
    Else
        IsJPTexts = False
    End If
End Function

' 日本語の文字をカウントする関数
Function CountJapaneseCharacters(inputText As Variant) 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
➤①GAS翻訳関数利用マクロ：GoogleAppsScriptサイトからURL設定し誰でも利用可能 
Option Explicit
'共通変数はANDpValsに記載

 
'ワークシート関数としても使用できます。
Public Function 旧Gootransl_DefJPandEN_GAS(rng As Variant, Optional TranslateFrom As String, Optional TranslateTo As String) As String

If rng = "" Then
    Gootransl_DefJPandEN_GAS = ""
    Exit Function
ElseIf rng = "@MAILTO" Then
    Gootransl_DefJPandEN_GAS = ""
    Exit Function
End If


'自動和英訳で連続翻訳時に１回目の言語判定が引き継がれること回避用変数
Dim LngToTranslateFrom As String, LngToTranslateTo As String

GAS_Status = ""

    '変数設定
    Dim param As Variant, url As String
    
    'HTTPリクエストの設定
    If objHTTP Is Nothing Then
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    End If

Dim GASurl As String
'前半url


If GASurl = "" Then GASurl = Trim(ThisWorkbook.Worksheets("Lng").Range("E8").Value)

If GASurl = "" Then
    MsgBox "Err:GAS翻訳用URLがシートに入力されていません。"
    Exit Function
End If
    
    'セルの値を取得　シート関数としても使えるように下記は残した
    If TypeName(rng) = "Range" Then
        
        param = rng.Value
        
    Else
        param = Trim(rng)
        
    End If
    
    If TranslateFrom = "" Or TranslateTo = "" Then
    
      If IsJPTexts(param, "0.4") Then
        LngToTranslateFrom = "ja"
        LngToTranslateTo = "en"
      Else
        LngToTranslateFrom = "en"
        LngToTranslateTo = "ja"
      End If
    
    Else
        
        LngToTranslateFrom = TranslateFrom
        LngToTranslateTo = TranslateTo
        
    End If

    'HTTPリクエストのURL設定
url = GASurl & _
      "?text=" & EncodeURL(param) & _
      "&source=" & LngToTranslateFrom & _
      "&target=" & LngToTranslateTo

objHTTP.Open "GET", url, False
objHTTP.send

If objHTTP.Status <> 200 Then

Select Case objHTTP.Status

    Case 400
        GAS_Status = "400: パラメータ不正"
    Case 401
        GAS_Status = "401: 認証エラー"
    Case 403
        GAS_Status = "403: アクセス拒否"
    Case 404
        GAS_Status = "404: URL誤り"
    Case 429
        GAS_Status = "429: 使いすぎ（時間をおいて）"
    Case 500
        GAS_Status = "500: GAS内部エラー"
    Case Else
        GAS_Status = "翻訳エラーです" & vbCr & "Err:" & objHTTP.Status & vbCr & "-" & param

End Select
    ExcelTraslateUF.TranslationStutas = GAS_Status
    Exit Function

End If

    
    'HTTPリクエストのレスポンステキストを取得
    'Dim oHtml As New MSHTML.HTMLDocument
    'If oHtml Is Nothing Then
    '    Set oHtml = New MSHTML.HTMLDocument
    'End If
    
    'oHtml.body.innerHTML = objHTTP.responseText
    'transtext = oHtml.getElementsByClassName("result-container")(0).innerText
    
    '翻訳結果を取得
    Dim transtext As String
    Dim TranslatedText As String
    TranslatedText = objHTTP.ResponseText
'     Debug.Print responce
    
    ' 高速化の為JSON解析はしない
    'On Error GoTo JsonError

    'Dim json As Object
    'Set json = JsonConverter.ParseJson(objHTTP.responseText)

    'response = CleanTranslatedText(json("text"))
   
    Dim p1 As Long, p2 As Long
    p1 = InStr(TranslatedText, """text"":""") + 8
    p2 = InStr(p1, TranslatedText, """")
    TranslatedText = Mid(TranslatedText, p1, p2 - p1)
  
  On Error GoTo 0

    '翻訳結果があればCleanTranslatedText関数を実行、なければエラー出力
    If TranslatedText <> "" Then
        
        Gootransl_DefJPandEN_GAS = CleanTranslatedText(transtext)
    
    Else
        Gootransl_DefJPandEN_GAS = "翻訳エラーです" & vbCr & CVErr(TranslatedText) & "-" & vbCr & param
    
    End If
    
    
    Exit Function

JsonError:
    
    Gootransl_DefJPandEN_GAS = "翻訳エラーです" & vbCr & "ErrJSON" & CVErr(xlErrValue) & "-" & vbCr & param
    Exit Function

End Function
Option Explicit
'共通変数はANDpValsに記載

'ワークシート関数としても使用できます。
Public Function GASTranslate_DefJPandEN( _
    rng As Variant, _
    Optional TranslateFrom As String = "", _
    Optional TranslateTo As String = "" _
) As String

    On Error GoTo ErrHandler

    '自動和英訳で連続翻訳時に１回目の言語判定が引き継がれること回避用変数
    Dim LngToTranslateFrom As String
    Dim LngToTranslateTo As String
    
    Dim param As String
    Dim url As String, response As String

    Dim TranslatedText As String
    Dim p1 As Long
    Dim p2 As Long

    GAS_Status = ""

    '--------------------------------
    ' 入力値取得
    '--------------------------------
    If TypeName(rng) = "Range" Then
        param = CStr(rng.Value)
    Else
        param = Trim$(CStr(rng))
    End If

    '空文字 / 特定文字は空返却
    If Trim$(param) = "" Then
        GASTranslate_DefJPandEN = ""
        Exit Function
    End If

    '--------------------------------
    ' HTTPオブジェクト生成
    '--------------------------------
    If objHTTP Is Nothing Then
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    End If

    '--------------------------------
    ' GAS URL取得  シート関数用
    '--------------------------------
    If GASurl = "" Then
        GASurl = Trim$(ThisWorkbook.Worksheets("Lng").Range("E8").Value)
    End If
    
    If GASurl = "" Then
        GAS_Status = "Err:GAS翻訳用URLがシートに入力されていません。"
        GASTranslate_DefJPandEN = GAS_Status
        Exit Function
    End If

    '--------------------------------
    ' 翻訳元/翻訳先言語決定
    '--------------------------------
    If TranslateFrom = "" Or TranslateTo = "" Then

        If IsJPTexts(param, "0.3") Then
            LngToTranslateFrom = "ja"
            LngToTranslateTo = "en"
        Else
            LngToTranslateFrom = "en"
            LngToTranslateTo = "ja"
        End If

    Else

        LngToTranslateFrom = TranslateFrom
        LngToTranslateTo = TranslateTo

    End If

    '--------------------------------
    ' URL組み立て
    '--------------------------------
    url = GASurl & _
          "?text=" & EncodeURL(param) & _
          "&source=" & LngToTranslateFrom & _
          "&target=" & LngToTranslateTo

    '--------------------------------
    ' HTTP送信
    '--------------------------------
    objHTTP.Open "GET", url, False
    objHTTP.send

    
    response = objHTTP.ResponseText
    
    '--------------------------------
    ' HTTPステータス確認
    '--------------------------------
    
    If objHTTP.Status <> 200 Then

        GASTranslate_DefJPandEN = GetCommonHttpErrorMessage( _
                                      objHTTP.Status, _
                                      "GAS", _
                                      param, _
                                      response)
        Exit Function
        
    End If

    '--------------------------------
    ' レスポンス取得
    '--------------------------------
    TranslatedText = objHTTP.ResponseText

    '--------------------------------
    ' JSONを簡易解析（"text":"..." を抜き出す）
    '--------------------------------
    p1 = InStr(1, TranslatedText, """text"":""")

    If p1 > 0 Then
        p1 = p1 + 8
        p2 = InStr(p1, TranslatedText, """")

        If p2 > p1 Then
            TranslatedText = Mid$(TranslatedText, p1, p2 - p1)
        Else
            TranslatedText = ""
        End If
    Else
        TranslatedText = ""
    End If

    '--------------------------------
    ' 結果返却
    '--------------------------------
    If TranslatedText <> "" Then
        GASTranslate_DefJPandEN = CleanTranslatedText(TranslatedText)
    Else
        GASTranslate_DefJPandEN = "翻訳エラーです" & vbCrLf & _
                                   "Err:レスポンス解析失敗" & vbCrLf & _
                                   "-" & param
    End If

    Exit Function

ErrHandler:
    GAS_Status = "Err:GAS翻訳でエラーが発生しました。" & vbCrLf & _
                 "No:" & Err.Number & vbCrLf & _
                 Err.Description

    GASTranslate_DefJPandEN = GAS_Status
End Function
➤②Google翻訳API利用マクロ：GoogleCloudで従課金登録し誰でも利用可能 
Option Explicit
'共通変数はANDpValsに記載


'ワークシート関数としても使用できます。
Public Function 旧GgleAPITranslate_DefJPandEN(rng As Variant, Optional TranslateFrom As String, Optional TranslateTo As String) As String


'APIキー
If GgleAPIkey = "" Or Len(GgleAPIkey) > 10 Then

    GgleAPIkey = Trim(ThisWorkbook.Worksheets("Lng").Range("E7").Value)

ElseIf InStr(1, GgleAPIkey, "Err") > 0 Then
    
    GgleAPIkey = Trim(ThisWorkbook.Worksheets("Lng").Range("E7").Value)
    
End If

If GgleAPIkey = "" Then
    
    GgleAPITranslate_DefJPandEN = "Err:APIキーがありません。Lngシートに記載してください。"
  
    Exit Function
    
End If



'自動和英訳で連続翻訳時に１回目の言語判定が引き継がれること回避用変数
Dim LngToTranslateFrom As String, LngToTranslateTo As String
                        
    '変数設定
    Dim param As Variant, url As String
    
    'HTTPリクエストの設定
    'Dim objHTTP As Object
    If objHTTP Is Nothing Then
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    End If
    
    'セルの値を取得　シート関数としても使えるように下記は残した
    If TypeName(rng) = "Range" Then
        param = rng.Value
    Else
        param = Trim(rng)
        
    End If
    
    '複数範囲ではない場合
    'If Not IsArray(param) Then
    
    '空白、数字だけや一文字で数字のみの場合
    'If param = "" Or IsNumeric(param) Or Len(param) <= 2 And IsNumeric(param) Then
    
    '    GgleAPITranslate_DefJPandEN = param
    '    Exit Function
    
    '2文字以下で且つ日本語ではない＝英語で2文字翻訳は不可で余計な文字と判断
    'ElseIf Len(param) <= 2 And Not IsJPTexts(param, "0.5") Then
        
    '    GgleAPITranslate_DefJPandEN = param
    '    Exit Function
        
    'End If
    
    'TranslselectedRngSubで処理有るが、関数でも使う場合の為記載
    If TranslateFrom = "" Or TranslateTo = "" Then
    
      If IsJPTexts(param, "0.3") Then
        LngToTranslateFrom = "ja"
        LngToTranslateTo = "en"
      Else
        LngToTranslateFrom = "en"
        LngToTranslateTo = "ja"
      End If
      
    Else
    
        LngToTranslateFrom = TranslateFrom
        LngToTranslateTo = TranslateTo
    
    End If
    
    
    
    'HTTPリクエストのURL設定
    url = "https://translation.googleapis.com/language/translate/v2" & _
          "?key=" & GgleAPIkey

Dim postdata As String
postdata = "{""q"":""" & JsonEscape(param) & """," & _
           """source"":""" & LngToTranslateFrom & """," & _
           """target"":""" & LngToTranslateTo & """," & _
           """format"":""text""}"

objHTTP.Open "POST", url, False
objHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
objHTTP.send postdata

    If objHTTP.Status <> 200 Then
        
        GgleAPITranslate_DefJPandEN = "ErrHttp:" & "ｴﾗｰ" & objHTTP.Status & "です。" & "403:キー不正,400:JSON不正,429:使いすぎetc"
        Exit Function
    
    End If
    
    'HTTPリクエストのレスポンステキストを取得
    'Dim oHtml As New MSHTML.HTMLDocument
    
    'If oHtml Is Nothing Then
    '    Set oHtml = New MSHTML.HTMLDocument
    'End If
    
    'oHtml.body.innerHTML = objHTTP.responseText
    'TranslatedText = oHtml.getElementsByClassName("result-container")(0).innerText
    
    '翻訳結果を取得
    Dim TranslatedText As String
    Dim response As String
    response = objHTTP.ResponseText

' JSON解析
    On Error GoTo JsonError

    Dim json As Object
    Set json = JsonConverter.ParseJson(response)

    TranslatedText = json("data")("translations")(1)("translatedText")

    On Error GoTo 0

    '翻訳結果があればCleanTranslatedText関数を実行、なければエラー出力
    If TranslatedText <> "" Then
        GgleAPITranslate_DefJPandEN = CleanTranslatedText(TranslatedText)
    Else
        GgleAPITranslate_DefJPandEN = CVErr(xlErrValue)
    End If
    
    Exit Function

JsonError:
    
    GgleAPITranslate_DefJPandEN = "ErrJSON" & CVErr(xlErrValue)
    Exit Function

End Function

'関数の説明
Sub RegisterGoogleTransleFormula()

    '関数名の設定
    Dim strFunc As String
    strFunc = "GgleAPITranslate_DefJPandEN"
    
    '関数の説明
    Dim strDesc As String
    strDesc = "GgleAPITranslate_DefJPandEN関数" & vbNewLine & vbNewLine & _
    "英語から日本語に翻訳したい場合、GgleAPITranslate_DefJPandEN(A1,""en"",""ja"")" & vbNewLine & vbNewLine & _
    "日本語から英語に翻訳したい場合、GgleAPITranslate_DefJPandEN(A1,""ja"",""en"")" & vbNewLine & vbNewLine & _
    "他の言語を使いたい場合は: https://cloud.google.com/translate/docs/languages/" & vbNewLine & "   "

    '関数内の引数の説明
    Dim strArgs(0 To 2) As String
    strArgs(0) = "翻訳したいセルを選択"
    strArgs(1) = "現在の言語を入力(ex. 英語はen,日本語はja)"
    strArgs(2) = "翻訳したい言語を入力(ex. 英語はen,日本語はja)他：中国語簡体:zh-CN, マレー語:ms,韓国語:ko"
    
    Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, category:="Custom Category"

End Sub


Option Explicit

'ワークシート関数としても使用できます。
Public Function GgleAPITranslate_DefJPandEN( _
    rng As Variant, _
    Optional TranslateFrom As String = "", _
    Optional TranslateTo As String = "" _
) As String

    On Error GoTo ErrHandler
    '自動和英訳で連続翻訳時に１回目の言語判定が引き継がれること回避用変数
    Dim LngToTranslateFrom As String
    Dim LngToTranslateTo As String
    
    
    Dim param As String
    Dim url As String
    Dim postdata As String
    Dim TranslatedText As String
    Dim response As String
    Dim json As Object

    '--------------------------------
    ' APIキー取得  UF実施済みだが関数用
    '--------------------------------
    If GgleAPIkey = "" Or Len(GgleAPIkey) < 10 Then
        GgleAPIkey = Trim$(ThisWorkbook.Worksheets("Lng").Range("E7").Value)
    ElseIf InStr(1, GgleAPIkey, "Err", vbTextCompare) > 0 Then
        GgleAPIkey = Trim$(ThisWorkbook.Worksheets("Lng").Range("E7").Value)
    End If

    If GgleAPIkey = "" Then
        GgleAPITranslate_DefJPandEN = "Err:APIキーがありません。Lngシートに記載してください。"
        Exit Function
    End If

    '--------------------------------
    ' 入力値取得
    '--------------------------------
    If TypeName(rng) = "Range" Then
        param = CStr(rng.Value)
    Else
        param = Trim$(CStr(rng))
    End If

    '--------------------------------
    ' スキップ対象
    '--------------------------------
    If Trim$(param) = "" Then
        GgleAPITranslate_DefJPandEN = ""
        Exit Function
    End If

    '--------------------------------
    ' HTTPオブジェクト生成
    '--------------------------------
    If objHTTP Is Nothing Then
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    End If

    '--------------------------------
    ' 翻訳元/先言語決定
    '--------------------------------
    If TranslateFrom = "" Or TranslateTo = "" Then

        If IsJPTexts(param, "0.3") Then
            LngToTranslateFrom = "ja"
            LngToTranslateTo = "en"
        Else
            LngToTranslateFrom = "en"
            LngToTranslateTo = "ja"
        End If

    Else

        LngToTranslateFrom = TranslateFrom
        LngToTranslateTo = TranslateTo

    End If

    '--------------------------------
    ' URL / POSTデータ作成
    '--------------------------------
    url = "https://translation.googleapis.com/language/translate/v2" & _
          "?key=" & GgleAPIkey

    postdata = "{""q"":""" & JsonEscape(param) & """," & _
               """source"":""" & LngToTranslateFrom & """," & _
               """target"":""" & LngToTranslateTo & """," & _
               """format"":""text""}"

    '--------------------------------
    ' API送信
    '--------------------------------
    objHTTP.Open "POST", url, False
    objHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
    objHTTP.send postdata

    response = objHTTP.ResponseText
    'Debug.Print response

    '--------------------------------
    ' HTTPエラー処理
    '--------------------------------
    If objHTTP.Status <> 200 Then
    
        GgleAPITranslate_DefJPandEN = GetCommonHttpErrorMessage( _
                                      objHTTP.Status, _
                                      "GoogleAPI", _
                                      param, _
                                      response)
        Exit Function
    
    End If
    
    '--------------------------------
    ' JSON解析
    '--------------------------------
    On Error GoTo JsonError

    Set json = JsonConverter.ParseJson(response)
    TranslatedText = json("data")("translations")(1)("translatedText")

    On Error GoTo ErrHandler

    '--------------------------------
    ' 結果返却
    '--------------------------------
    If TranslatedText <> "" Then
        GgleAPITranslate_DefJPandEN = CleanTranslatedText(TranslatedText)
    Else
        GgleAPITranslate_DefJPandEN = "Err:翻訳結果が空です。"
    End If

    Exit Function

JsonError:
    GgleAPITranslate_DefJPandEN = "ErrJSON: Google APIの応答解析に失敗しました。"
   
    Exit Function

ErrHandler:
    GgleAPITranslate_DefJPandEN = "Err:Google API翻訳でエラーが発生しました。" & vbCrLf & _
                                  "No:" & Err.Number & vbCrLf & _
                                  Err.Description
    
End Function
➤③AzureAI翻訳API利用マクロ：AzureでAPIkey取得し基本無料で誰でも利用可能（利用プランや量による） 
Option Explicit
'共通変数はANDpValsに記載

Public Function AzureAPITranslate_DefJPandEN( _
    rng As Variant, _
    Optional TranslateFrom As String = "", _
    Optional TranslateTo As String = "" _
) As String

    On Error GoTo ErrHandler

    'Azure設定値key等はTranslateANDpValで共通宣言
    
    Dim url As String, json As Object
    
    '自動和英訳で連続翻訳時に１回目の言語判定が引き継がれること回避用変数
    Dim LngToTranslateFrom As String
    Dim LngToTranslateTo As String
    
    Dim TranslatedText As String
    Dim param As String, postdata As String, response As String


    '未設定時のデフォルト　シート関数用
    If AzureEndP = "" Then AzureEndP = "https://api.cognitive.microsofttranslator.com"
    If AzureReg = "" Then AzureReg = "japaneast"
    If AzureAPIkey = "" Then
        AzureAPIkey = Replace(ThisWorkbook.Worksheets("lng").Range("E10"), """", " ")
            If AzureAPIkey = "" Then
                AzureAPITranslate_DefJPandEN = "Err:Azure APIキーがありません。Lngシートに記載してください。"
                Exit Function
            End If

    End If

    '--------------------------------
    ' 入力値取得
    '--------------------------------
    If TypeName(rng) = "Range" Then
        param = CStr(rng.value)
    Else
        param = Trim$(CStr(rng))
    End If

    '--------------------------------
    ' スキップ対象
    '--------------------------------
    If Trim$(param) = "" Then
        AzureAPITranslate_DefJPandEN = ""
        Exit Function
    End If

    '--------------------------------
    ' HTTPオブジェクト生成
    '--------------------------------
    If objHTTP Is Nothing Then
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    End If

    '--------------------------------
    ' 翻訳元/先言語決定
    '--------------------------------
    If TranslateFrom = "" Or TranslateTo = "" Then

        If IsJPTexts(param, "0.3") Then
            LngToTranslateFrom = "ja"
            LngToTranslateTo = "en"
        Else
            LngToTranslateFrom = "en"
            LngToTranslateTo = "ja"
        End If

    Else

        LngToTranslateFrom = TranslateFrom
        LngToTranslateTo = TranslateTo

    End If

    '--------------------------------
    ' URL / POSTデータ作成
    '--------------------------------
    url = AzureEndP & "/translate?api-version=3.0&from=" & LngToTranslateFrom & "&to=" & LngToTranslateTo
    postdata = "[{""Text"":""" & JsonEscape(param) & """}]"

    '--------------------------------
    ' API送信
    '--------------------------------
    With objHTTP
        .Open "POST", url, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Ocp-Apim-Subscription-Key", AzureAPIkey
        .setRequestHeader "Ocp-Apim-Subscription-Region", AzureReg
        .send postdata
    End With

    response = objHTTP.ResponseText

    '--------------------------------
    ' HTTPエラー処理
    '--------------------------------
    If objHTTP.Status <> 200 Then

        AzureAPITranslate_DefJPandEN = GetCommonHttpErrorMessage( _
                                            objHTTP.Status, _
                                            "AzureAPI", _
                                            param, _
                                            response)
        Exit Function

    End If

    '--------------------------------
    ' JSON解析
    '--------------------------------
    On Error GoTo JsonError

    Set json = JsonConverter.ParseJson(response)
    TranslatedText = json(1)("translations")(1)("text")

    On Error GoTo ErrHandler

    '--------------------------------
    ' 結果返却
    '--------------------------------
    If TranslatedText <> "" Then
        AzureAPITranslate_DefJPandEN = CleanTranslatedText(TranslatedText)
    Else
        AzureAPITranslate_DefJPandEN = "Err:翻訳結果が空です。"
    End If

    Exit Function

JsonError:
    AzureAPITranslate_DefJPandEN = "ErrJSON: Azure APIの応答解析に失敗しました。"
    Exit Function

ErrHandler:
    AzureAPITranslate_DefJPandEN = "Err:Azure API翻訳でエラーが発生しました。" & vbCrLf & _
                                     "No:" & Err.Number & vbCrLf & _
                                     Err.Description
End Function

今マクロはAPIキーなどの情報をシート上から取得し実行する方法としています。共有等する際の漏洩には十分注意ください。

API利用による返答はJSON形式となります。その為上記API使用時は、JSON Converterメソッドにより、対象の返答部分の実を取得する必要があります。必要なメソッドはGitHubからダウンロードし、VBA編集画面にドラッグアンドドロップしてください。

なお上記のファイルをダウンロードすれば、対象サービスのKey等があれば翻訳可能です。

選択したbasファイルをVBE画面にドラッグアンドドロップ

また、エラーが起きる場合は参照設定でMicrosoft Scripting Runtime とHTMLObjectLibarary等下記参照設定がされていることを確認してください。*一括翻訳マクロ用設定も含まれていますが、ご容赦ください。

下記表示が出る場合はAlt＋F11を押し、下記標準モジュール2つを自身のマクロブックにドラッグアンドドロップしてください。

・ポイント機能

・Optionalによる自動和英判定

・各サービスHttp通信時のエラー処理

・引数への指定言語

Optionalによる自動和英判定

関数では引数に翻訳元言語と、翻訳対象言語を設定します。これはoptionalで指定しなくても設定が可能です。設定しない場合は、IsJP関数により、対象文での日本語の割合に応じて和英判定がされます。

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

としています。

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

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

関数は2つあり、

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

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

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

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

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

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

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

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

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

各サービスHttp通信時のエラー処理

各翻訳関数使用のための関数や共有変数は下記プロシージャで管理しています。

GASやAPI翻訳があり、多少エラー内容が異なる場合がありますが、ある程度網羅しています。

個人利用する場合のエラーはたいていはAPIKeyなどの不正がありますので、エラー時はシート上のAPIに間違いがないかご確認ください。

引数への言語指定

Google翻訳では、翻訳元言語と翻訳対象言語の二つを指定し、翻訳をしています。今回の関数では、第1引数に翻訳元の言語を、第2因数に翻訳先の言語を設定します。

翻訳後の設定は二文字で行います。これはISO 639-1という国際標準の枠組みの一つで定められています。全世界で共通のルールの下で世界中の言語を数文字のアルファベットで表している標準です。これ以外にも複数の標準が存在します。

日本語であればjp、英語であればenとその言語の英語表記から代表的となる文字を組み合わせて文字が表現されます。すべてが2文字というわけではなく、同じ言語でも国によって異なる場合は数文字増えて識別されます。例えば中国語で言っても下記表記法があります。

言語表記言語
zh中国語
zh-CN *中国語（簡体字）
zh-TW *中国語（繁体字）
言語表記の一例

・MS公式Translate関数、代替翻訳マクロ

これまでエクセルでの翻訳は、他アプリから或いは、校閲タブにある翻訳機能を使うしかありませんでした。そこで翻訳関数作成の意味があったわけですが公式からTranslate関数が導入されました。TRANSLATE 関数 - Microsoft サポート

また、Copilotによるエージェントモード（共同編集モード）の機能追加により、シートの翻訳はより一層簡単になりました。

ただ、2025年9月25日らへんで使用した際には、引数候補がうまく作動しなかったり、busyマークのまま翻訳できない時がありました。また、これでは他のマクロで翻訳機能追加などはd系ません。

そんなときのため、アドインとして今マクロを登録しておくのも多少は役に立ちます。また、Translate関数及びCopilot共同編集モードは、マイクロソフトの一部プランのみ現状利用可能のため、他のマクロに翻訳機能を付けたい場合はこのマクロが役立ちます。

他の代替翻訳実現方法としては、ChatGPTAPIによるAI使用、Web操作できるSeleniumVBAがあります。ChatGPT返答取得関数、SeleniumVBAによるGoogle翻訳/Copilot返答取得関数マクロを参考に紹介します。

Translate関数その他代替案使用要件等
Copilot返答取得関数マクロ有料MS Copilotプランが必要
ChatGPT返答取得関数ChatGPT会員登録しAPI用トークン購入が必要
SeleniumVBAによるGoogle翻訳ブラウザ側のHTML要素変更時等は手動更新必要&動作大遅延（利用規約上問題ないか要確認）

・応用例:指定範囲/シート一括翻訳、動的メール作成

上記機能を応用し、翻訳元/先言語＆翻訳対象範囲/シートを選択可能にしたマクロです。実行するとユーザーフォームが表示され、言語と範囲を指定できます。シート翻訳時は図形文字も対象に翻訳し、複数シート選択時は一括で其々のシート翻訳が可能です。今回紹介のワークシート翻訳関数の引数をVariantに変更する等修正することで、今回紹介した翻訳関数と一括翻訳マクロの両方を使用できます。

さらに、対象の文字列内容の和文割合応じて自動和英訳ができる機能から、メール作成においても活用できます。下記マクロではUFから選択したメールに対する動的メール作成ができ、UF上で手動チェックするか、選択したメール文内容に応じて返信文を自動和英訳できます。

・Google Apps Scriptによる翻訳

①GAS翻訳関数利用マクロでは、翻訳関数のhttp部分をGAS対応にすることにより、有料のAPIを使用せずGoogle公式の翻訳関数を無料で使用することができます。

方法は右記事を参考にさせていただきました。参考:Google翻訳APIを無料で作る方法 #GAS - Qiita

これを参考に利用規約違反の防止とAPI利用のための課金なしでも翻訳が実現できます。Google apps script: GASを用いており、Google公式の関数の為利用規約の問題はないと考えられます。ただし公式の見解があればそれに準ずることが必要です為、ご承知おきください。

単純なJSON操作の高速化

無料でできる反面、その裏には速度面で多少欠点があります。動作の速さにおいてHttp通信の他にGASによる処理が追加されるため、API利用の場合よりも処理速度が鈍化します。体感、速さは4/5くらいになり、文字が多ければさらに遅延が大きくなります。

高速化としてマクロではJsonconvertを使用せず、単純なJson値取得としています。ただしマクロで早くしようとしても、セル1つ → HTTP → GAS → 翻訳 → 戻るの繰り返しがあるためこれ以上の高速化は限界があります。

JSONレスポンスからの単純な抽出

出力形式はGAS上でJSON形式で指定しており、返答は下記のような単純なJSONとなっています。構成が単純なため、今マクロではJSON Converterを使用せず単純なスクリプトとしています。

返答はcodeとtextの単純なJSON形式

作成したプロジェクトのリンクを元に、翻訳関数が無料で使用できますが、全員が使用できるように設定する必要があります。作成後はOne Driveにプロジェクトが保存されているため、共有からリンクを知っている全員に設定します。

このリンクを指定すると翻訳関数使用可能。ただし共有の設定が必要
OneDriveにプロジェクトが表示されている
共有を押し、一般的なアクセスをリンクを知っている全員とする

上記設定が完了し、下記指定箇所にURLが記載されていれば翻訳が可能です。

Preurlに上記のURLを記載する

Preurlとしているのは、Httpリクエストにおいて、さらに翻訳テキストと翻訳元・先言語の指定が必要なためです。

・Google翻訳API取得方法

②Google翻訳API利用マクロ使用のためにGoogle翻訳APIを取得する必要があります。GoogleではGoogle Cloud Translation APIという翻訳専用のAPIが提供されています。下記は入手の手順です。入手後は②Google翻訳API利用マクロの冒頭箇所に記載してください。

APIKEYを記載する箇所

ステップ1：Googleアカウントでログイン

まずは Google Cloud Console にアクセスして、Googleアカウントでログイン

ステップ2：プロジェクトを作成

  1. 画面上部の「プロジェクトを選択」→「新しいプロジェクト」
  2. プロジェクト名を入力（例：「翻訳プロジェクト」など）
  3. 「作成」をクリック

ステップ3：Translation API を有効化

  1. 左上のメニュー（三本線）→「APIとサービス」→「ライブラリ」
  2. 「Cloud Translation API」と検索
  3. 出てきたらクリックして「有効にする」

ステップ4：APIキーを取得

  1. 左メニューの「APIとサービス」→「認証情報」
  2. 「認証情報を作成」→「APIキー」
  3. 自動的にAPIキーが生成されるので、コピーして安全な場所に保存※キーは厳重に管理する

ステップ5：課金の有効化（無料枠あり）

Google Cloudは初回登録で$300分の無料クレジットもらえる（※時期によって変動あり）。数十万以上文字は無料で翻訳可能です。

  1. 「課金」メニューから支払い情報を登録
  2. 無料枠を使い切るまでは課金されない仕組み

ステップ6：使い方を確認

APIキーを取得したら、あとは以下のようなURLで翻訳可能になります

「https://translation.googleapis.com/language/translate/v2?q=こんにちは&target=en&key=YOUR_API_KEY」

-業務効率化