Traductor desde cualquier idioma a cualquier idioma

Solo aportes de interés para otros usuarios Excel
Estos foros NO son para preguntas!
Reglas del Foro
En estos foros solo puedes hacer aportes Excel de interés para la comunidad (no son para hacer preguntas!)
Responder
Avatar de Usuario
leuro
Miembro Frecuente
Miembro Frecuente
Mensajes: 37
Registrado: 08 Mar 2010 02:43
Ubicación: Bogotá Colombia

Traductor desde cualquier idioma a cualquier idioma

Mensaje por leuro » 28 Abr 2013 18:25

Hola a todos.

Aqui una funcion bastante util para traducir a cualquier idioma ...

Salu2.

Código: Seleccionar todo


Function FunTraducir(Mss As String, out As String)

    Dim ie As Object
    Dim WebPage As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim vWord As String
    Dim current As Workbook
    Dim rng As Range
    Dim lrow As Long
    Dim Rw_Start As Long
    Dim GetValue As String
    Dim Translated_Text
    Dim Transl_Text
    Dim MyText As String
'    Dim GetValue As String
    
    Select Case out
        Case "Afrikaans": Idioma = "af"
        Case "Albanian": Idioma = "sq"
        Case "Arabic": Idioma = "ar"
        Case "Armenian": Idioma = "hy"
        Case "Azerbaijani": Idioma = "az"
        Case "Basque": Idioma = "eu"
        Case "Belarusian": Idioma = "be"
        Case "Bengali": Idioma = "bn"
        Case "Bulgarian": Idioma = "bg"
        Case "Catalan": Idioma = "ca"
        Case "Chinese": Idioma = "zh-CN"
        Case "Croatian": Idioma = "hr"
        Case "Czech": Idioma = "cs"
        Case "Danish": Idioma = "da"
        Case "Dutch": Idioma = "nl"
        Case "English": Idioma = "en"
        Case "Esperanto": Idioma = "eo"
        Case "Estonian": Idioma = "et"
        Case "Filipino": Idioma = "tl"
        Case "Finnish": Idioma = "fi"
        Case "French": Idioma = "fr"
        Case "Galician": Idioma = "gl"
        Case "Georgian": Idioma = "ka"
        Case "German": Idioma = "de"
        Case "Greek": Idioma = "el"
        Case "Gujarati": Idioma = "gu"
        Case "Haitian Creole": Idioma = "ht"
        Case "Hebrew": Idioma = "iw"
        Case "Hindi": Idioma = "hi"
        Case "Hungarian": Idioma = "hu"
        Case "Icelandic": Idioma = "is"
        Case "Indonesian": Idioma = "id"
        Case "Irish": Idioma = "ga"
        Case "Italian": Idioma = "it"
        Case "Japanese": Idioma = "ja"
        Case "Kannada": Idioma = "kn"
        Case "Korean": Idioma = "ko"
        Case "Latin": Idioma = "la"
        Case "Latvian": Idioma = "lv"
        Case "Lithuanian": Idioma = "lt"
        Case "Macedonian": Idioma = "mk"
        Case "Malay": Idioma = "ms"
        Case "Maltese": Idioma = "mt"
        Case "Norwegian": Idioma = "no"
        Case "Persian": Idioma = "fa"
        Case "Polish": Idioma = "pl"
        Case "Portuguese": Idioma = "pt"
        Case "Romanian": Idioma = "ro"
        Case "Russian": Idioma = "ru"
        Case "Serbian": Idioma = "sr"
        Case "Slovak": Idioma = "sk"
        Case "Slovenian": Idioma = "sl"
        Case "Spanish": Idioma = "es"
        Case "Swahili": Idioma = "sw"
        Case "Swedish": Idioma = "sv"
        Case "Tamil": Idioma = "ta"
        Case "Telugu": Idioma = "te"
        Case "Thai": Idioma = "th"
        Case "Turkish": Idioma = "tr"
        Case "Ukrainian": Idioma = "uk"
        Case "Urdu": Idioma = "ur"
        Case "Vietnamese": Idioma = "vi"
        Case "Welsh": Idioma = "cy"
        Case "Yiddish": Idioma = "yi"

Case Else
Idioma = "es"
End Select
    
    out = Idioma
    
     '' Cierra los servicios de IExplorer
      Dim objWMI As Object, objProcess As Object, objProcesses As Object
    Set objWMI = GetObject("winmgmts://.")
    Set objProcesses = objWMI.ExecQuery( _
        "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
    For Each objProcess In objProcesses
        Call objProcess.Terminate
    Next
    Set objProcesses = Nothing: Set objWMI = Nothing
     
     
    Set ie = CreateObject("InternetExplorer.Application")
    vWord = Mss ' ActiveWorkbook.Sheets(2).Range("A" & i).Value
    
    Inn = "auto"
    
    WebPage = "http://translate.google.com/#" & Inn & "/" & out & "/" & vWord
    ie.Visible = False
    ie.navigate WebPage
    Application.Wait (Now + TimeValue("0:00:5"))
    
    Do Until ie.ReadyState = 4 'For STATE as COMPLETE
    DoEvents
    Loop
    'ie.Visible = True
    
    '' Se captura varias veces para forzar el valor
    GetValue = ie.document.getElementById("result_box").innerHTML
    GetValue = ie.document.getElementById("result_box").innerHTML
    GetValue = ie.document.getElementById("result_box").innerHTML
    GetValue = ie.document.getElementById("result_box").innerHTML
    GetValue = ie.document.getElementById("result_box").innerHTML
    GetValue = ie.document.getElementById("result_box").innerHTML
    GetValue = ie.document.getElementById("result_box").innerHTML
    Translated_Text = Split(GetValue, ">")
    
    For j = 0 To UBound(Translated_Text)
        If InStr(1, Translated_Text(j), "</", vbTextCompare) > 0 Then
            Transl_Text = Split(Translated_Text(j), "</")
            MyText = MyText & " " & Transl_Text(0)
        End If
    Next j
    
    FunTraducir = MyText
    Set Translated_Text = Nothing
'    Close_IE
    Set ie = Nothing
    
End Function






Avatar de Usuario
TodoExcel
Manager Exceluciones
Manager Exceluciones
Mensajes: 1665
Registrado: 05 Jun 2004 16:05

Re: Traductor desde cualquier idioma a cualquier idioma

Mensaje por TodoExcel » 29 Abr 2013 10:07

Gracias por el aporte...

Faltan definir estas 3 variables: idioma, Inn, J

También sería bueno una sencilla explicación de uso sobre todo para los que no tengan mucha experiencia.

Salu2.xls



pedrinclub
Miembro Frecuente
Miembro Frecuente
Mensajes: 23
Registrado: 30 Oct 2013 10:30

Re: Traductor desde cualquier idioma a cualquier idioma

Mensaje por pedrinclub » 17 Abr 2014 13:12

Disculpen mi ignorancia, como aplico, la traduccion



Responder