tradurre It-En da Excel tramite VBA

[pic omnic]

Qualche anno fa norman jones aveva scritto una procedura VBA che permetteva di collegarsi a Google Traslate da Excel. Nella Colonna A si inserivano i termini in italiano e nella col B venivano restituite le relative traduzioni. L' ultima volta che l'ho usata (circa un paio di anni fa) funzionava senza problemi. Oggi però non funzionava più. Non segnala errore di sintassi ; ma non traduce più. Evidentemente google traslate ha cambiato qualche parametro. C'è qualcuno che può dare un occhiata al codice VBA per provare a ripristinare l utile funzionalità ? Grazie 1000 a chi si interesserà al problema.
draleo

il file incriminato è al link

https://www.dropbox.com/s/nwl67gm2detrvju/Traduzioni%20It-En.xlsm?dl=0

il suo codice VBA è il seguente:

Option Explicit

Dim IE As InternetExplorer
Dim arrProblemi() As Variant
Dim iRecord As Long, iProblemi As Long

Public Const langCode = ("auto,en,fr,es,it")

'--------->>
Public Enum LanguageCode
InputAuto = 0
InputEnglish = 1
InputFrench = 2
InputSpanish = 3
InputItalian = 4
End Enum

'--------->>
Public Enum LanguageCode2
ReturnEnglish = 1
ReturnFrench = 2
ReturnSpanish = 3
ReturnItalian = 4
End Enum

'--------->>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim arrIn As Variant, arrOut() As Variant
Dim sStr As String
Dim UB As Long, LRow As Long
Dim iCtr As Long, iVuoto As Long
Dim iTradotto As Long
Dim sMsg As String, sProblemi As String, sProblemCells As String
Dim dStart As Double

Const sInputLanguage = ReturnItalian
Const sOutputLanguage = ReturnEnglish

'Const sInputLanguage = ReturnEnglish
'Const sOutputLanguage = ReturnItalian

Application.EnableCancelKey = xlInterrupt
On Error GoTo ErrHandler
Call MsgBox( _
Prompt:="L'elaborazione delle descrizioni verra' indicata " _
& "sulla barra" & " di stato sul fondo della schermata", _
Buttons:=vbInformation, _
Title:="ELABORAZIONE RECORD")
dStart = Timer

Set WB = ThisWorkbook
Set SH = WB.Sheets("Foglio1") '<<==== Modifica
With SH
LRow = LastRow(SH, .Columns("A:A"))
'MsgBox LRow
Set Rng = .Range("A2:A" & LRow)
End With

arrIn = Rng.Value
UB = UBound(arrIn)
ReDim arrOut(1 To UB, 1 To 1)

For iRecord = 1 To UB
Application.StatusBar = "Processing Record " & iRecord & " di " & UB
sStr = arrIn(iRecord, 1)
If Not sStr = vbNullString Then
arrOut(iRecord, 1) = AutoTranslate(sStr, sInputLanguage, _
sOutputLanguage)
Else
iVuoto = iVuoto + 1
End If
Next iRecord

With Application
.ScreenUpdating = False
Rng.Offset(0, 1).Value = arrOut
.ScreenUpdating = True
.StatusBar = False
End With

iTradotto = UB - iVuoto - iProblemi
sProblemi = Join(arrProblemi, vbNewLine)
sProblemCells = IIf(CBool(iProblemi), _
" problemi con le seguente celle: ", " problemi")

Call MsgBox( _
Prompt:=UB & " Record sono stati elaborati di cui " _
& vbNewLine _
& "Vuoti = " & iVuoto _
& vbNewLine _
& "Tradotti = " & iTradotto _
& vbNewLine & vbNewLine _
& "C'erano stati riscontrati " & iProblemi _
& sProblemCells _
& vbNewLine _
& sProblemi, _
Buttons:=vbInformation, _
Title:="REPORT")

XIT:
IE.Quit
Set IE = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
On Error GoTo 0
Exit Sub

ErrHandler:
Call MsgBox( _
Prompt:="Errore " & Err.Number _
& " (" & Err.Description & ") nella routine Tester", _
Buttons:=vbCritical, _
Title:="ERRORE")
Resume XIT
End Sub

'--------->>
Public Function AutoTranslate(ByVal Text As String, _
Optional LanguageFrom As LanguageCode, _
Optional LanguageTo As LanguageCode2) As String

Dim langFrom As String, langTo As String
Dim URL As String
Dim myArray As Variant

If IsMissing(LanguageFrom) Then
LanguageFrom = InputAuto
End If
If IsMissing(LanguageTo) Then
LanguageTo = ReturnEnglish
End If

myArray = Split(langCode, ",")
langFrom = myArray(LanguageFrom)
langTo = myArray(LanguageTo)

URL = "https://translate.google.com/#" _
& langFrom & "/" & langTo & "/" & Text

If IE Is Nothing Then
Set IE = New InternetExplorer
End If

On Error GoTo XIT
With IE
.Visible = False
.Navigate URL

Do Until .ReadyState = 4
DoEvents
Loop

Application.Wait (Now + TimeValue("0:00:01"))

Do Until .ReadyState = 4
DoEvents
Loop

'prova a sostituire

AutoTranslate = .Document.getElementByID("result_box").innerText



'con (unica riga )

'AutoTranslate = .Document.getElementsByClassName("result-shield-container tlid-copy-target")(0).getElementsByClassName("tlid-translation translation")(0).getElementsByTagName("span")(0).innerText

End With
Exit Function
XIT:
iProblemi = iProblemi + 1
ReDim Preserve arrProblemi(1 To iProblemi)
arrProblemi(iProblemi) = iRecord
End Function

'--------->>
Public Function LastRow(SH As Worksheet, _
Optional Rng As Range, _
Optional minRow As Long = 1)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
If LastRow < minRow Then
LastRow = minRow
End If
End Function
'<<=========

[casanmaner]

Ho provato a inserire "good moring" indicando la lingua di partenza come inglese e di destinazione come italiano e la url che si crea è la seguente:

https://translate.google.com/?sl=en&tl=it&text=good%20morning&op=translate

Forse ricombinando la URL riesci di nuovo a ottenere la traduzione

[pic omnic]

mah...non so come fare. ma non credo sia una questione di URL. Ho provato mettere un punto di interruzione a livello di riga

AutoTranslate = .Document.getElementByID("result_box").innerText

e ad eseguire in finestra immediata l'istruzione
IE.Visible = True
E, come si vede dalla foto allegata,
appare la schermata di google traslate dove si vede che la prima parola da tradurre (marrone) è stata recepita e pure tradotta in Inglese (brown). il problema è che la traduzione non viene restituita sul foglio excel.
https://www.dropbox.com/s/hry30zy3tobacuy/google%20translate.jpg?dl=0
Boh...
draleo

[casanmaner]

Vedo che il testo tradotto è contenuto in un elmento "class" nominato "Q4iAWc"
Forse con qualcosa del genere magari si riesce a estrarre il testo tradotto

.Document.getElementsByClassName("Q4iAWc")(0).InnerText

sperando che di class nominati in quel modo ce ne sia solo uno perché altrimenti occorre capire quanti ce ne sono e in che posizione si trova quello desiderato.

[pic omnic]

No. Non cambia niente. Ma mi è venuto un dubbio "tremendo". il mio PC non mi permette di collegarmi a certi siti che iniziano con https. Non c'è stato nessuno, tra i tanti"specialisti" interpellati, che abbia capito il motivo e che mi abbia indicato come risolvere il problema in maniera incruenta (se non gettarlo o riformattare tutto ex nuovo). E' improbabile, ma Non vorrei che questa "defaillance" fosse dovuta al mio PC (e non alla procedura). stasera cerco un un altro PC per verificarlo.
draleo

[casanmaner]

Il giorno lunedì 13 giugno 2022 alle 16:28:40 UTC+2 dra...@libero.it ha scritto:

> No. Non cambia niente. Ma mi è venuto un dubbio "tremendo". il mio PC non mi permette di collegarmi a certi siti che iniziano con https. Non c'è stato nessuno, tra i tanti"specialisti" interpellati, che abbia capito il motivo e che mi abbia indicato come risolvere il problema in maniera incruenta (se non gettarlo o riformattare tutto ex nuovo). E' improbabile, ma Non vorrei che questa "defaillance" fosse dovuta al mio PC (e non alla procedura). stasera cerco un un altro PC per verificarlo.
> draleo

Provando il tuo file e aumentando il tempo e utilizzando la classname ho ottenuto i valori tradotti

Application.Wait (Now + TimeValue("0:00:02"))

AutoTranslate = .Document.getElementsByClassName("Q4iAWc")(0).innerText

[pic omnic]

No. Non cambia niente. Quindi ,come ho tardivamente intuito, il malfunzionamento dipende dal mio "stramaledetto PC".Chiedo venia. Grazie per avermi indirizzato alla soluzione
draleo