' ==============================================================================
' MACRO WORD: Traduzione a Fronte (Bilingual Side-by-Side Table)
' ==============================================================================
' Traduce il testo selezionato in Microsoft Word e lo affianca automaticamente
' al testo originale creando una tabella bilingue a 2 colonne (paragrafo per paragrafo).
' Non richiede alcuna API key o libreria esterna.
' ==============================================================================

Sub TraduciAFronte()
    On Error GoTo ErroreGenerale
    
    Dim sel As Selection
    Set sel = Application.Selection
    
    ' 1. Verifica che ci sia del testo selezionato
    If sel.Type = wdSelectionIP Or Len(Trim(sel.Text)) <= 1 Then
        MsgBox "Seleziona prima il testo che desideri tradurre.", vbExclamation, "Traduzione a Fronte"
        Exit Sub
    End If
    
    Dim rawText As String
    rawText = sel.Text
    
    ' 2. Suddivide il testo in singoli paragrafi
    Dim lines() As String
    rawText = Replace(rawText, vbCrLf, vbCr)
    rawText = Replace(rawText, vbLf, vbCr)
    lines = Split(rawText, vbCr)
    
    Dim paras() As String
    Dim count As Long
    count = 0
    Dim i As Long
    For i = LBound(lines) To UBound(lines)
        If Len(Trim(lines(i))) > 0 Then
            ReDim Preserve paras(count)
            paras(count) = Trim(lines(i))
            count = count + 1
        End If
    Next i
    
    If count = 0 Then
        MsgBox "Nessun paragrafo valido trovato nella selezione.", vbExclamation, "Traduzione a Fronte"
        Exit Sub
    End If
    
    Application.StatusBar = "Traduzione a fronte in corso..."
    Application.ScreenUpdating = False
    
    ' 3. Aggira l'errore 6028: cancella la selezione simulando la digitazione a video
    On Error Resume Next
    sel.TypeText ""
    On Error GoTo ErroreGenerale
    
    ' 4. Crea la tabella a 2 colonne esattamente dove si trova il cursore
    Dim tbl As Table
    Set tbl = sel.Tables.Add(Range:=sel.Range, NumRows:=count + 1, NumColumns:=2)
    
    ' 5. Formattazione Intestazione
    tbl.Cell(1, 1).Range.Text = "Originale"
    tbl.Cell(1, 2).Range.Text = "Traduzione (Inglese)"
    tbl.Rows(1).Range.Bold = True
    tbl.Rows(1).Shading.BackgroundPatternColor = RGB(236, 236, 236)
    tbl.Rows(1).HeadingFormat = True ' Ripete l'intestazione su ogni pagina
    
    ' 6. Inserimento traduzioni riga per riga
    Dim targetLang As String
    targetLang = "en" ' "en" inglese, "fr" francese, "de" tedesco, "es" spagnolo
    
    For i = 0 To count - 1
        tbl.Cell(i + 2, 1).Range.Text = paras(i)
        tbl.Cell(i + 2, 2).Range.Text = EseguiTraduzione(paras(i), "auto", targetLang)
    Next i
    
    ' 7. Bordi e adattamento automatico
    tbl.Borders.Enable = True
    tbl.AutoFitBehavior wdAutoFitWindow
    
    Application.ScreenUpdating = True
    Application.StatusBar = "Traduzione completata!"
    Exit Sub

ErroreGenerale:
    Application.ScreenUpdating = True
    MsgBox "Si è verificato un errore: " & Err.Description, vbCritical, "Traduzione a Fronte"
End Sub

' Funzione di traduzione HTTP
Function EseguiTraduzione(testo As String, linguaOrigine As String, linguaDestinazione As String) As String
    On Error GoTo GestioneErrore
    
    Dim url As String
    url = "https://translate.googleapis.com/translate_a/single?client=gtx&sl=" & linguaOrigine & _
          "&tl=" & linguaDestinazione & "&dt=t&q=" & EncodeURL_UTF8(testo)
    
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.Open "GET", url, False
    http.setRequestHeader "User-Agent", "Mozilla/5.0"
    http.Send
    
    Dim resp As String
    resp = http.responseText
    
    ' Estrazione del testo tradotto dal JSON
    Dim risultato As String
    risultato = ""
    Dim p1 As Long, p2 As Long
    p1 = InStr(resp, "[[[""")
    
    While p1 > 0
        p1 = p1 + 4
        p2 = InStr(p1, resp, """,""")
        If p2 > p1 Then
            risultato = risultato & Mid(resp, p1, p2 - p1)
            p1 = InStr(p2, resp, ",[""")
            If p1 > 0 Then p1 = p1 + 2
        Else
            p1 = 0
        End If
    Wend
    
    ' Pulizia caratteri di escape
    risultato = Replace(risultato, "\""", """")
    risultato = Replace(risultato, "\n", vbCrLf)
    
    If Len(risultato) = 0 Then risultato = testo
    EseguiTraduzione = risultato
    Exit Function

GestioneErrore:
    EseguiTraduzione = "[Errore: " & Err.Description & "]"
End Function

' Codifica UTF-8 nativa (gestisce correttamente le lettere accentate à, è, é, ì, ò, ù)
Function EncodeURL_UTF8(txt As String) As String
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2
    stream.Charset = "utf-8"
    stream.Open
    stream.WriteText txt
    stream.Position = 0
    stream.Type = 1
    
    Dim bytes() As Byte
    bytes = stream.Read
    stream.Close
    
    Dim res As String
    res = ""
    Dim i As Long, b As Byte
    For i = LBound(bytes) To UBound(bytes)
        b = bytes(i)
        If (b >= 48 And b <= 57) Or (b >= 65 And b <= 90) Or (b >= 97 And b <= 122) Then
            res = res & Chr(b)
        ElseIf b = 32 Then
            res = res & "%20"
        Else
            res = res & "%" & Right("0" & Hex(b), 2)
        End If
    Next i
    EncodeURL_UTF8 = res
End Function
