In some other thread, there are discussion about auto spellchecking.
Here is the code I use in all my applications to do automatique translation of sentences.
NB : You need to have a DeepL key https://support.deepl.com/hc/en-us/a...entication-Key
Sample of use
? Translate_Online("This is an emergency broadcast system", "EN", "FR")
Il s'agit d'un système de diffusion d'urgence
? Translate_Online("This is an emergency broadcast system", "EN", "IT")
Si tratta di un sistema di trasmissione di emergenza
? Translate_Online("This is an emergency broadcast system", "EN", "ES")
Este es un sistema de radiodifusión de emergencia
Here is the code I use in all my applications to do automatique translation of sentences.
NB : You need to have a DeepL key https://support.deepl.com/hc/en-us/a...entication-Key
Sample of use
? Translate_Online("This is an emergency broadcast system", "EN", "FR")
Il s'agit d'un système de diffusion d'urgence
? Translate_Online("This is an emergency broadcast system", "EN", "IT")
Si tratta di un sistema di trasmissione di emergenza
? Translate_Online("This is an emergency broadcast system", "EN", "ES")
Este es un sistema de radiodifusión de emergencia
Code:
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 07/25/2023
' * Time : 10:57
' * Module Name : DeepL_Module
' * Module Filename :
' * Purpose :
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Option Explicit
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function GetACP Lib "kernel32" () As Long
Private Const CP_ACP = 0
Private Const CP_UTF8 = 65001
Private Const cDeepLKey As String = "HERE YOUR DEEPL KEY"
Global Const DeepL_FR As String = "fr"
Global Const DeepL_NL As String = "nl"
Global Const DeepL_DE As String = "de"
Global Const DeepL_EN As String = "en"
Public Function Translate_Online(sText As String, sLangFrom As String, sLangTo As String) As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 06/19/2020
' * Time : 17:28
' * Module Name : DeepL_Module
' * Module Filename :
' * Procedure Name : Translate_Online
' * Purpose :
' * Parameters :
' * sText As String
' * sLangFrom As String
' * sLangTo As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim sTmp As String
If LenB(sText) > 0 Then
sTmp = sText
Do While InStrB(sTmp, "..") > 0
sTmp = Replace(sTmp, "..", ".")
Loop
Translate_Online = Translate_DeepL(sTmp, sLangFrom, sLangTo)
End If
End Function
Private Function Translate_DeepL(sText As String, sLangFrom As String, sLangTo As String) As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 02/12/2022
' * Time : 15:55
' * Module Name : DeepL_Module
' * Module Filename :
' * Procedure Name : Translate_DeepL
' * Purpose :
' * Parameters :
' * sText As String
' * sLangFrom As String
' * sLangTo As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_Translate_DeepL
Dim oHTTPDeepL As Object
Dim sURL As String
Dim sReturn As String
Dim sTranslated As String
Set oHTTPDeepL = CreateObject("Msxml2.XMLHTTP.6.0")
sURL = "https://api-free.deepl.com/v2/translate?"
sURL = sURL & "text=" & URLEncode(sText) & ""
sURL = sURL & "&source_lang=" & sLangFrom & ""
sURL = sURL & "&target_lang=" & sLangTo & ""
sURL = sURL & "&tag_handling=xml"
With oHTTPDeepL
Call .Open("POST", sURL, 0)
Call .setRequestHeader("Host", "api-free.deepl.com")
Call .setRequestHeader("User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/79.0.3945.79 Safari/537.36")
Call .setRequestHeader("Accept", "*/*")
Call .setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call .setRequestHeader("Authorization", "DeepL-Auth-Key " & cDeepLKey & "")
Call .sEnd
sReturn = .responseText
End With
sTranslated = GetStringBetweenTags(sReturn, """text"":""", """}]")
Translate_DeepL = Replace(sTranslated, "\r\n", vbCrLf)
EXIT_Translate_DeepL:
On Error Resume Next
Set oHTTPDeepL = Nothing
Exit Function
' #VBIDEUtilsERROR#
ERROR_Translate_DeepL:
Resume EXIT_Translate_DeepL
End Function
Public Function GetStringBetweenTags(ByVal sSearchIn As String, ByVal sFrom As String, ByVal sUntil As String, Optional nPosAfter As Long, Optional ByRef nStartAtPos As Long = 0) As String
' #VBIDEUtils#***********************************************************
' * Programmer Name :
' * Web Site :
' * E-Mail :
' * Date : 01/15/2001
' * Time : 13:31
' * Module Name : DeepL_Module
' * Module Filename :
' * Procedure Name : GetStringBetweenTags
' * Parameters :
' * ByVal sSearchIn As String
' * ByVal sFrom As String
' * ByVal sUntil As String
' * Optional nPosAfter As Long
' * Optional ByRef nStartAtPos As Long = 0
' **********************************************************************
' * Comments :
' * This function gets in a string and two keywords
' * and returns the string between the keywords
' *
' **********************************************************************
Dim nPos1 As Long
Dim nPos2 As Long
Dim nPos As Long
nPos1 = InStr(nStartAtPos + 1, sSearchIn, sFrom, vbTextCompare)
nPos2 = InStr(nPos1 + Len(sFrom), sSearchIn, sUntil, vbTextCompare)
If (nPos1 > 0) And (nPos2 > 0) Then
Dim sFound As String
sFound = Mid$(sSearchIn, nPos1 + Len(sFrom), nPos2 - (nPos1 + Len(sFrom)))
nPosAfter = nPos2 - 1
End If
GetStringBetweenTags = sFound
End Function
Public Function URLEncode(sPlain As String, Optional bSpaceAsPlus As Boolean = False, Optional bUTF8Encode As Boolean = True) As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 07/14/2014
' * Time : 08:21
' * Module Name : DeepL_Module
' * Module Filename :
' * Procedure Name : URLEncode
' * Purpose :
' * Parameters :
' * sPlain As String
' * Optional bSpaceAsPlus As Boolean = False
' * Optional bUTF8Encode As Boolean = True
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim sPlainCopy As String
Dim nLen As Long
sPlainCopy = IIf(bUTF8Encode, UTF16To8(sPlain), sPlain)
nLen = Len(sPlainCopy)
If nLen > 0 Then
ReDim Result(nLen) As String
Dim nI As Long
Dim sCharCode As Integer
Dim sChar As String
Dim sSpace As String
If bSpaceAsPlus Then sSpace = "+" Else sSpace = "%20"
For nI = 1 To nLen
sChar = Mid$(sPlainCopy, nI, 1)
sCharCode = Asc(sChar)
Select Case sCharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
Result(nI) = sChar
Case 32
Result(nI) = sSpace
Case 0 To 15
Result(nI) = "%0" & Hex(sCharCode)
Case Else
Result(nI) = "%" & Hex(sCharCode)
End Select
Next nI
URLEncode = Join(Result, vbNullString)
End If
End Function
Public Function UTF16To8(ByVal sUTF16 As String) As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 07/14/2014
' * Time : 08:23
' * Module Name : DeepL_Module
' * Module Filename :
' * Procedure Name : UTF16To8
' * Purpose :
' * Parameters :
' * ByVal sUTF16 As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim sBuffer As String
Dim lLength As Long
If LenB(sUTF16) > 0 Then
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sUTF16), -1, 0, 0, 0, 0)
sBuffer = Space$(lLength)
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sUTF16), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
sBuffer = StrConv(sBuffer, vbUnicode)
UTF16To8 = Left$(sBuffer, lLength - 1)
Else
UTF16To8 = vbNullString
End If
End Function