PIECE OF CAKE - VBA Excel - Traduzindo Planilhas - MS Excel VBA Script to Translate worksheets using the Google Translate API


Existem códigos de Perl para traduzir planilhas MS Excel usando o Google Translate ao passo que preserva a formatação. Diga-se de passagem, essa maneira é demorada, não confiável, complicada, etc. Acredito que esta seja solução melhor.

Coloque o código abaixo em sua planilha MS Excel habilitada para processar código VBA em sua pasta de trabalho pessoal e crie um atalho para isso (use Ctrl + shift + t). Este código usará o Google Translate API. Ele traduzirá todas as células não-vazias e não numéricas na planilha ativa, colocando a tradução em uma nova planilha, mantendo a formatação original. Colocará o valor original das células numéricas (não traduzidas) na nova planilha.


A nova planilha terá o mesmo nome da planilha original, com o código de duas letras do idioma selecionado nela. Se uma planilha com esse nome já existir, será excluída.


Ao executar o código, precisará especificar alguns parâmetros em uma caixa de diálogo que aparecerá:

1. Sua chave da API do Google. A API de tradução do Google não é gratuita, custa uns US$ 20 por cada 1MB de caracteres
2. Código da língua de duas letras do idioma origem
3. Código da língua de duas letras do idioma destino

(Nos intens 2 e 3, precisará usar os códigos de idioma que a API de tradução do Google suporta. Consulte-os aqui)




Sub TranslateWorsheet()

   ' A função original está codificação aqui.

   ' Antes de executar este script, adicione a versão mais atualizada do
   ' Microsoft Script Control como
   ' referência (Ferramentas -> Referências no Editor VB)

   ' Passo 1: Crie uma nova planilha: worksheetname_2lettertargetlanguagecode

   ' Passo 2: Na folha atual, faça um looping em todas as células não vazias
   ' A) envie o pedido REST para a API para traduzir o conteúdo da célula se não for
   ' numérico, de outra forma, cole o conteúdo original da célula.
   ' B) colocar o conteúdo traduzido na célula correspondente da nova planilha.
   ' C) copiar também a formatação da célula.

    Dim destinationWorksheetName As String

    Dim sourceWorksheetName As String
    Dim cellContent As String
    Dim cellAddress As String
    Dim sourceWorksheet As Worksheet
    Dim destinationWorksheet As Worksheet
     
    Dim ScriptEngine As ScriptControl
    Set ScriptEngine = New ScriptControl
    Let ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function encode(str) {return encodeURIComponent(str);}"
     
    ' use regualr expression to get the translation
    Dim RE As Object
    Set RE = CreateObject("VBScript.RegExp")
    Let RE.Pattern = "\[\s*{\s*""translatedText"": ""(.*)""\s}*"
    Let RE.IgnoreCase = False
    Let RE.Global = False
    Let RE.MultiLine = True
    Dim testResult As Boolean
    
    ' send the translation request
    Dim REMatches As Object
    Dim translateD As String
    Dim sourceString As String
    Dim K As String
    Dim URL As String
    Dim encodedSourceString As String
    Dim sourceLanguage As String
    Dim destinationLanguage As String
    Set sourceWorksheet = ActiveSheet
    Let sourceWorksheetName = ActiveSheet.Name
    
    ' sourceString = "Hello World"
    Let destinationLanguage = "EN"
    Let sourceLanguage = "PT"
    Let K = InputBox(prompt:="Please enter your Google Translate API key", Title:="Google Translate API Key Required: For more info, see https://developers.google.com/translate/v2/getting_started")

    'obTranslateOptions.Show

    'sourceLanguage = obTranslateOptions.obSourceLanguage.Text
    'destinationLanguage = obTranslateOptions.obDestinationLanguage.Text
    'K = obTranslateOptions.obKey.Text

    'Debug.Print "K=" & K

    'Debug.Print "sourceLanguage=" & sourceLanguage
    'Debug.Print "destinationLanguage=" & destinationLanguage
    
    ' Unload obTranslateOptions
    
    ' If a worksheet of this name in this workbook already exist, then delete it
    Let destinationWorksheetName = sourceWorksheetName & "_" & destinationLanguage
    Let Application.DisplayAlerts = False
    On Error Resume Next
    Sheets(destinationWorksheetName).Delete
    Let Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' Prepare to send the request
    Dim objHTTP As Variant
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim responseT As String
       
    ' copy active worksheet, clear contents of the copy
    ActiveWorkbook.ActiveSheet.Copy after:=ActiveWorkbook.ActiveSheet
    Let ActiveSheet.Name = destinationWorksheetName
    ActiveSheet.Cells.ClearContents
    Set destinationWorksheet = ActiveSheet
    
    sourceWorksheet.Activate
    ' loop through all non-empty cells or all selected cells
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Cells
    
        'Debug.Print cell.Address
        Let cellAddress = cell.Address
        Let sourceString = cell.Value
        'Debug.Print "sourceString:" & sourceString
    
        ' do only for non-numeric cells
        If (IsNumeric(cell.Value) = False) Then
                
            ' encode the source text
            Let encodedSourceString = ScriptEngine.Run("encode", sourceString)
            ' prepare and send the request
            Let URL = "https://www.googleapis.com/language/translate/v2?key=" & K & "&source=" & sourceLanguage & "&target=" & destinationLanguage & "&q=" & encodedSourceString
            objHTTP.Open "GET", URL, False
            objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
            objHTTP.send ("")
            responseT = objHTTP.ResponseText
            ' Debug.Print "responseT:" & responseT
        
            ' pull the translation from the response to the request
            If (RE.Test(responseT) = True) Then
                'Debug.Print "re.test is true"
                Set REMatches = RE.Execute(responseT)
                Let translateD = REMatches.Item(0).SubMatches.Item(0)
                'Debug.Print "translateD:" & translateD
            Else
                'Debug.Print "re.test is false"
            End If
        
            destinationWorksheet.Range(cellAddress).Value = translateD
        Else
            destinationWorksheet.Range(cellAddress).Value = cell.Value
        End If
    Next
    

End Sub




#A&A #API #Google #GoogleTranslate #GoogleTranslateAPI #GoogleTranslator #MSEXCEL #Perl #PIECEOFCAKE #script #translate #POC #VBA



Defina a Latitude e a Longitude - Find Latitude and Longitude of any address using Google Map API and VBA


VBA Excel - Traduzindo Planilhas - MS Excel VBA Script to Translate worksheets using the Google Translate API
VBA Excel - Traduzindo Planilhas - MS Excel VBA Script to Translate worksheets using the Google Translate API

Excel - Manipule o Google Maps em sua Planilha - Put a Google Map in your Spreadsheet
Excel - Manipule o Google Maps em sua Planilha - Put a Google Map in your Spreadsheet

Convertendo Texto em Imagem - Convert Text to an Image using the VBA Windows API
Convertendo Texto em Imagem - Convert Text to an Image using the VBA Windows API

Correção de Métricas - For Subscripts, Superscripts and Common Typos
Correção de Métricas - For Subscripts, Superscripts and Common Typos

MS Access - Cinco Formas Manuais de Reparo
MS Access - Cinco Formas Manuais de Reparo

MS Access e MS Word - Técnica de Automação
MS Access e MS Word - Técnica de Automação

Microsoft Access - Removendo Prefixo das Tabelas
Microsoft Access - Removendo Prefixo das Tabelas

Sempre Use Stored Procedures - Always Use Stored Procedures
Sempre Use Stored Procedures - Always Use Stored Procedures

A&A - Dados ou Informações?
A&A - Dados ou Informações?


Consulte-nos

⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 


⬛◼◾▪ CONTATO ▪

Nenhum comentário:

Postar um comentário

diHITT - Notícias