Option Explicit



Public Function Translate_English_To_Japanese(ByVal Text As String) As String

    Translate_English_To_Japanese = Translate("EN", "JA", Text)

End Function

Public Function Translate_Japanese_To_English(ByVal Text As String) As String

    Translate_Japanese_To_English = Translate("JA", "EN", Text)

End Function



'https://www.deepl.com/ja/docs-api/glossaries/ 

Private Function Translate(ByVal sourceLang As String, ByVal targetLang As String, ByVal Text As String, Optional ByVal AuthKey As String = YOUR_AUTH_KEY) As String

    Dim strReq As String

    strReq = "text=" & Replace(WorksheetFunction.EncodeURL(Text), "%20", "+")

    If sourceLang <> "" Then strReq = strReq & ("&source_lang=" & sourceLang)

    If targetLang <> "" Then strReq = strReq & ("&target_lang=" & targetLang)

    

    Dim xDoc As MSXML2.XMLHTTP60

    Set xDoc = New MSXML2.XMLHTTP60

    xDoc.Open "POST", "https://api-free.deepl.com/v2/translate?" & strReq, False

    xDoc.setRequestHeader "Authorization", "DeepL-Auth-Key " & AuthKey

    xDoc.send

    If xDoc.Status = 200 Then

        'この JSON の .translations.text 部に訳文が入っている 

        Dim rawJson As String

        rawJson = xDoc.responseText



        '本来は JSON 用のライブラリで読み取った方が良い 

        Dim translated As String

        translated = Split(rawJson, """", 10)(9)

        translated = Left(translated, Len(translated) - 4)

        translated = Replace(translated, "\\", "\")

        translated = Replace(translated, "\r", vbCr)

        translated = Replace(translated, "\n", vbLf)

        translated = Replace(translated, "\t", vbTab)



        Translate = translated

    Else

        Debug.Print xDoc.Status, xDoc.statusText

        Translate = vbNullString

        'Stop 

    End If

End Function