XL 2019 translateAddin ne marche pas

[lamho27]

Bonjour le forum

J’ai un problème addin translate ne marche pas si j’ai activé « Protection contre les virus et menaces »

Pouvez-vous me corriger ce problème

Merci d’avance

Global myRibbon As IRibbonUI
Global fromLanguageCode As String
Global toLanguageCode As String
Sub Onload(ribbon As IRibbonUI)
Set myRibbon = ribbon
End Sub
Sub GetFromItemCount(ByVal control As IRibbonControl, ByRef count)
Application.OnKey "+^T", "TranslateRanges"
count = UBound(GetLanguages) - LBound(GetLanguages) + 1
End Sub
Sub GetFromItemLabel(ByVal control As IRibbonControl, index As Integer, ByRef label)
label = GetLanguages()(index)
End Sub
Sub GetFromSelectedItemIndex(ByVal control As IRibbonControl, ByRef index)
End Sub
Sub InsertFromLanguage(ByVal control As IRibbonControl, selectedID As String, selectedIndex As Integer)
fromLanguageCode = GetLanguageCode(CLng(selectedIndex))
End Sub
Sub GetToItemCount(ByVal control As IRibbonControl, ByRef count)
count = UBound(GetLanguages) - LBound(GetLanguages) + 1
End Sub
Sub GetToItemLabel(ByVal control As IRibbonControl, index As Integer, ByRef label)
label = GetLanguages()(index)
End Sub
Sub GetToSelectedItemIndex(ByVal control As IRibbonControl, ByRef index)
End Sub
Sub InsertToLanguage(ByVal control As IRibbonControl, selectedID As String, selectedIndex As Integer)
toLanguageCode = GetLanguageCode(CLng(selectedIndex))
End Sub
Sub Translate(control As IRibbonControl)
TranslateRanges
End Sub
Public Sub TranslateRanges()
Dim r As Range
For Each r In Selection
r.Value = TranslateText(r.Value, fromLanguageCode, toLanguageCode)
Next r
End Sub
Function GetLanguages() As String()
Dim languages As String
languages = "Afrikaans|Albanian|Arabic|Azerbaijani|Basque|Belarusian|Bengali|Bulgarian|Catalan|Chinese_Simplified|Chinese_Traditional|Croatian|Czech|Danish|Dutch|English|Esperanto|Estonian|Filipino|Finnish|French|Galician|Georgian|German|Greek|Gujarati|Haitian_Creole|Hebrew|Hindi|Hungarian|Icelandic|Indonesian|Irish|Italian|Japanese|Kannada|Korean|Latin|Latvian|Lithuanian|Macedonian|Malay|Maltese|Norwegian|Persian|Polish|Portuguese|Romanian|Russian|Serbian|Slovak|Slovenian|Spanish|Swahili|Swedish|Tamil|Telugu|Thai|Turkish|Ukrainian|Urdu|Vietnamese|Welsh|Yiddish"
GetLanguages = Split(languages, "|")
End Function
Function GetLanguageCode(index As Long) As String
Dim languages As String
languages = "af|sq|ar|az|eu|be|bn|bg|ca|zh-cn|zh-TW|hr|cs|da|nl|en|eo|et|tl|fi|fr|gl|ka|de|el|gu|ht|iw|hi|hu|is|id|ga|it|ja|kn|ko|la|lv|lt|mk|ms|mt|no|fa|pl|pt|ro|ru|sr|sk|sl|es|sw|sv|ta|te|th|tr|uk|ur|vi|cy|yi"
GetLanguageCode = Split(languages, "|")(index)
End Function
Function TranslateText(str As String, translateFrom As String, translateTo As String) As String
If str = "" Or str = vbNullString Or Trim(str) = "" Or Trim(str) = vbNullString Then
TranslateText = str
Exit Function
End If
Dim getParam As String, trans As String
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
getParam = ConvertToGet(str)
URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
trans = RegexExecuteGet(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>", 0, 0)
TranslateText = Clean(trans)
Else
Err.Raise 0, "Translate", "No connection or other error"
End If
End Function
Private Function ConvertToGet(val As String)
val = Replace(val, " ", "+")
val = Replace(val, vbNewLine, "+")
val = Replace(val, "(", "%28")
val = Replace(val, ")", "%29")
ConvertToGet = val
End Function
Private Function Clean(val As String)
val = Replace(val, "&quot;", """")
val = Replace(val, "%2C", ",")
val = Replace(val, "&#39;", "'")
Clean = val
End Function
Function RegexExecuteGet(str As String, reg As String, Optional matchIndex As Long = 0, Optional subMatchIndex As Long = 0) As String
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For efficiency
If regex.Test(str) Then
Set matches = regex.Execute(str)
RegexExecuteGet = matches(matchIndex).SubMatches(subMatchIndex)
Exit Function
End If
End Function