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!)

Traductor desde cualquier idioma a cualquier idioma

Notapor 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
leuro
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 37
Registrado: 08 Mar 2010 02:43
Ubicación: Bogotá Colombia

Re: Traductor desde cualquier idioma a cualquier idioma

Notapor 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
Avatar de Usuario
TodoExcel
Manager Exceluciones
Manager Exceluciones
 
Mensajes: 1664
Registrado: 05 Jun 2004 16:05

Re: Traductor desde cualquier idioma a cualquier idioma

Notapor pedrinclub » 17 Abr 2014 13:12

Disculpen mi ignorancia, como aplico, la traduccion
pedrinclub
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 23
Registrado: 30 Oct 2013 10:30


Volver a TUS APORTES

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 2 invitados