it-swarm.com.de

Übersetzen Sie Text mit vba

könnte eine seltene Petition sein, aber hier ist das Problem. 

Ich passe ein Excel eines Drittanbieters an meine Organisation an. Das Excel ist auf Englisch entwickelt und die Leute in meiner Organisation sprechen nur Spanisch. Ich möchte genau den gleichen Code wie das Original-Arbeitsblatt verwenden. Ich möchte es lieber nicht anfassen (obwohl ich das auch kann). Daher möchte ich eine Funktion verwenden, mit der jedes Mal, wenn eine msgbox erscheint (mit dem Text in Englisch) , Ich übersetze die msgbox-Nachrichten, ohne das ursprüngliche Skript zu berühren. Ich suche nach einer Maske, die jedes Mal aufgerufen werden kann, wenn eine msgbox im ursprünglichen Code aufgerufen wird. 

Ich ziehe es vor, den Originalcode nicht zu berühren, da der Entwickler von Drittanbietern den Code häufig ändern kann. Es kann sehr ärgerlich sein, den Code jedes Mal zu ändern, wenn er eine kleine Änderung vornimmt. 

Ist das möglich? 

8
MariPlaza

Bitte schön.

  Sub test()
    Dim s As String
    s = "hello world"
    MsgBox transalte_using_vba(s)

End Sub


 Function transalte_using_vba(str) As String
' Tools Refrence Select Microsoft internet Control


    Dim IE As Object, i As Long
    Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String, CLEAN_DATA

    Set IE = CreateObject("InternetExplorer.application")
    '   TO CHOOSE INPUT LANGUAGE

    inputstring = "auto"

    '   TO CHOOSE OUTPUT LANGUAGE

    outputstring = "es"

    text_to_convert = str

    'open website

    IE.Visible = False
    IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

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

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")

    For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
        result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
    Next


    IE.Quit
    transalte_using_vba = result_data


End Function
15
Santosh

So würde ich es machen. Es funktioniert mit optionalen Aufzählungsobjekten, die auf von Google translate verwendete Sprachcodes verweisen. Der Einfachheit halber habe ich nur einige Sprachcodes hinzugefügt. In diesem Beispiel habe ich auch die Microsoft Internet Controls-Referenz ausgewählt. Statt ein Objekt zu erstellen, wird ein InternetExplorer-Objekt verwendet. Und schließlich habe ich, um die Ausgabe zu bereinigen, einfach .innerText anstelle von .innerHTML verwendet. Denken Sie daran, dass es bei google translate ein Zeichenlimit von etwa 3000 gibt. Außerdem müssen Sie IE = nichts setzen, insbesondere wenn Sie dies mehrmals verwenden. Andernfalls erstellen Sie mehrere IE-Prozesse und Irgendwann wird es nicht mehr funktionieren.

Konfiguration...

Option Explicit

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

Public Enum LanguageCode
    InputAuto = 0
    InputEnglish = 1
    InputFrench = 2
    InputSpanish = 3
End Enum

Public Enum LanguageCode2
    ReturnEnglish = 1
    ReturnFrench = 2
    ReturnSpanish = 3
End Enum

Prüfung...

Sub Test()

Dim msg As String

msg = "Hello World!"

MsgBox AutoTranslate(msg, InputEnglish, ReturnSpanish)

End Sub

Funktion...

Public Function AutoTranslate(ByVal Text As String, Optional LanguageFrom As LanguageCode, Optional LanguageTo As LanguageCode2) As String

Dim langFrom As String, langTo As String, IE As InternetExplorer, URL As String, myArray

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

Set IE = New InternetExplorer

IE.Visible = False
IE.Navigate URL

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

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

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

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

    IE.Quit

    Set IE = Nothing


End Function
5
Josh

Eine der modernen Lösungen, die die Google Translation API verwenden. Um die Google Translation API zu aktivieren, müssen Sie zunächst das Projekt und die Anmeldeinformationen erstellen. Wenn Sie 403 (Tageslimit) erhalten, müssen Sie Ihrem Google Cloud-Konto eine Zahlungsmethode hinzufügen. Die Ergebnisse werden dann sofort angezeigt.

Private Function GoogleTranslateJ(ByVal text, ByVal resLang, ByVal srcLang) As String
Dim jsonProvider As Object

Dim jsonResult As Object
Dim jsonResultText As String

Dim googleApiUrl As String
Dim googleApiKey As String

Dim resultText As String

Set jsonProvider = CreateObject("MSXML2.ServerXMLHTTP")

text = Replace(text, " ", "%20")
googleApiKey = "ijHF28h283fjijefiwjeofij90f2h923" 'YOUR GOOGLE API KEY

googleApiUrl = "https://translation.googleapis.com/language/translate/v2?key=" & googleApiKey & "&source=" & srcLang & "&target=" & resLang & "&q=" & text

jsonProvider.Open "POST", googleApiUrl, False
jsonProvider.setRequestHeader "Content-type", "application/text"
jsonProvider.send ("")
jsonResultText = jsonProvider.responseText

Set jsonResult = JsonConverter.ParseJson(jsonResultText)
Set jsonResult = jsonResult("data")
Set jsonResult = jsonResult("translations")
Set jsonResult = jsonResult(1)

resultText = jsonResult("translatedText")

GoogleTranslateJ = resultText
End Function
1
Vitalii Ivanov

Update: Verbesserte For Each v In arr_Response- Iteration, wodurch spezielle Zeichen möglich sind. Mauszeigeränderung hinzugefügt, wenn die Übersetzung verarbeitet wird. Ein Beispiel zur Verbesserung des übersetzten output_string wurde hinzugefügt.

Es gibt einen Großteil der freien Übersetzungs-APIs, aber keines scheint Googles Translation Service (GTS) zu schlagen (meiner Meinung nach). Aufgrund der Einschränkungen von Googles für die kostenlose GTS-Nutzung scheint der beste VBA-Ansatz auf die IE.navigation beschränkt zu sein - wie auch die Antwort von Santosh unterstreicht. 

Die Verwendung dieses Ansatzes verursacht einige Probleme. Die IE-Instans wissen nicht, wann die Seite vollständig geladen ist, und IE.ReadyState ist wirklich nicht vertrauenswürdig. Daher muss der Codierer mit der Funktion Application.Wait "Verzögerungen" hinzufügen. Wenn Sie diese Funktion verwenden, raten Sie nur, wie lange es dauern würde, bis die Seite vollständig geladen ist. In Situationen, in denen das Internet wirklich langsam ist, reicht diese hartcodierte Zeit möglicherweise nicht aus. Der folgende Code behebt dies mit ImprovedReadyState. 

In Situationen, in denen ein Arbeitsblatt über unterschiedliche Spalten verfügt und Sie in jede Zelle eine andere Übersetzung einfügen möchten, finde ich die beste Methode, bei der die Übersetzungszeichenfolge dem ClipBoard zugewiesen wird, anstatt eine VBA-Funktion aus der Formel heraus aufzurufen. Dadurch können Sie die Übersetzung einfach einfügen und als Zeichenfolge ändern.

 Columns in Excel

Verwendung:

  1. Fügen Sie die Prozeduren in ein benutzerdefiniertes VBA-Modul ein
  2. Ändern Sie die 4 Const's nach Ihren Wünschen (siehe oben TranslationText)
  3. Weisen Sie einen Kurzbefehl zum Auslösen des TranslationText- Verfahrens zu

 Shortkey Excel

  1. Aktivieren Sie die Zelle, die Sie übersetzen möchten. Die erste Zeile muss mit einem Sprach-Tag enden. Usw. "_da", "_en", "_de". Wenn Sie eine andere Funktionalität wünschen, ändern Sie ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

 enter image description here

  1. Drücken Sie die Kurzwahltaste von 4. (usw. STRG + SHIRT + S). Siehe proces in Ihrer Prozessleiste (unten in Excel). Einfügen (STRG + V), wenn die Übersetzung angezeigt wird:

 enter image description here  Translation done

    Option Explicit

    'Description: Translates content, and put the translation into ClipBoard
    'Required References: MIS (Microsoft Internet Control)
    Sub TranslateText()

    'Change Const's to your desire
    Const INPUT_RANGE As String = "table_products[productname_da]"
    Const INPUT_LANG As String = "da"
    Const PROCESSBAR_INIT_TEXT As String = "Processing translation. Please wait... "
    Const PROCESSBAR_DONE_TEXT As String = "Translation done. "

    Dim ws_ActiveWS As Worksheet
    Dim r_ActiveCell As Range, r_InputRange As Range
    Dim s_InputStr As String, s_InputLang As String, s_OutputLang As String, arr_Response() As String, s_Translation As String
    Dim o_IE As Object, o_MSForms_DataObject As Object
    Dim i As Long
    Dim v As Variant

    Set o_MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set ws_ActiveWS = ThisWorkbook.ActiveSheet
    Set r_ActiveCell = ActiveCell
    Set o_IE = CreateObject("InternetExplorer.Application")
    Set r_InputRange = ws_ActiveWS.Range(INPUT_RANGE)

    'Update statusbar ("Processing translation"), and change cursor
    Application.Statusbar = PROCESSBAR_INIT_TEXT
    Application.Cursor = xlWait

    'Declare inputstring (The string you want to translate from)
    s_InputStr = ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

    'Find the output-language
    s_OutputLang = Right(ws_ActiveWS.Cells(1, r_ActiveCell.Column).Value, 2)

    'Navigate to translate.google.com
    With o_IE

        .Visible = False 'Run IE in background
        .Navigate "http://translate.google.com/#" & INPUT_LANG & "/" _
            & s_OutputLang & "/" & s_InputStr

        'Call improved IE.ReadyState
        Do
            ImprovedReadyState
        Loop Until Not .Busy

        'Split the responseText from Google
        arr_Response = Split(.Document.getElementById("result_box").innerHTML, "<span class")

        'Remove html from response, and construct full-translation-string
        For Each v In arr_Response
            s_Translation = s_Translation & Replace(v, "<span>", "")
            s_Translation = Replace(s_Translation, "</span>", "")
            s_Translation = Replace(s_Translation, """", "")
            s_Translation = Replace(s_Translation, "=hps>", "")
            s_Translation = Replace(s_Translation, "=atn>", "")
            s_Translation = Replace(s_Translation, "=hps atn>", "")

            'Improve translation.
            'This could etc. be moved to seperate sheets (containing every language), and make the lookup in a dynamic table/sheet. Futurely it'd be possible to hook on the changeevent, and automatically improve the translation-algoritmen.
            'If Google can't translate the etc. the Word "Lys", you can extend the translation, with an auto correction. This example shows to autocorrect the Word "Lys" -> "ljus". 
            If (s_OutputLang = "sv") Then
                s_Translation = Replace(s_Translation, "lys", "ljus")
            End if
        Next v

        'Put Translation into Clipboard
        o_MSForms_DataObject.SetText s_Translation
        o_MSForms_DataObject.PutInClipboard

        If (s_Translation <> vbNullString) Then
            'Put Translation into Clipboard
            o_MSForms_DataObject.SetText s_Translation
            o_MSForms_DataObject.PutInClipboard

            'Update statusbar ("Translation done"). If the input_string is above 70 chars (which is roughly the limitation in processbar), then cut the string, and extend with "...".
            Application.Statusbar = PROCESSBAR_DONE_TEXT & """" & IIf(Len(s_InputStr) < 70, s_InputStr, Mid(s_InputStr, 1, 70) & "...") & """"
        Else
            'Update statusbar ("Error")
            Application.Statusbar = PROCESSBAR_ERROR_TEXT
        End If

        'Cleanup
        .Quit

        'Change cursor back to default
        Application.Cursor = xlDefault

        Set o_MSForms_DataObject = Nothing
        Set ws_ActiveWS = Nothing
        Set r_ActiveCell = Nothing
        Set o_IE = Nothing

    End With

End Sub

Sub ImprovedReadyState()

    Dim si_PauseTime As Single: si_PauseTime = 1 'Set duration
    Dim si_Start As Single: si_Start = Timer 'Set start-time
    Dim si_Finish As Single 'Set end-time
    Dim si_TotalTime As Single 'Calculate total time.

    Do While Timer < (si_Start + si_PauseTime)
        DoEvents
    Loop

    si_Finish = Timer

    si_TotalTime = (si_Finish - si_Start)

End Sub
1
Unicco

Die Antwort von Unicco ist großartig!

Ich habe das Tabellenmaterial entfernt und es aus einer einzelnen Zelle heraus arbeiten lassen, aber das Ergebnis ist das gleiche.

Mit einem Teil des von mir übersetzten Textes (Bedienungsanweisungen in einem Fertigungskontext) fügt Google gelegentlich der zurückgegebenen Zeichenfolge Mist hinzu und verdoppelt manchmal sogar die Antwort, wobei zusätzliche <"span"> - Konstrukte verwendet werden.

Ich habe die folgende Zeile direkt nach 'Next v' in den Code eingefügt:

s_Translation = RemoveSpan(s_Translation & "")

Und erstellt diese Funktion (fügen Sie zu demselben Modul hinzu):

Private Function RemoveSpan(Optional InputString As String = "") As String

Dim sVal As String
Dim iStart As Integer
Dim iEnd As Integer
Dim iC As Integer
Dim iL As Integer

If InputString = "" Then
    RemoveSpan = ""
    Exit Function
End If

sVal = InputString

' Look for a "<span"
iStart = InStr(1, sVal, "<span")

Do While iStart > 0 ' there is a "<span"
    iL = Len(sVal)
    For iC = iStart + 5 To iL
        If Mid(sVal, iC, 1) = ">" Then Exit For ' look for the first ">" following the "<span"
    Next
    If iC < iL Then ' then we found a "<"
        If iStart > 1 Then ' the "<span" was not in the beginning of the string
            sVal = Left(sVal, iStart - 1) & Right(sVal, iL - iC) ' grab to the left of the "<span" and to the right of the ">"
        Else ' the "<span" was at the beginning
            sVal = Right(sVal, iL - iC) ' grap to the right of the ">"
        End If
    End If
    iStart = InStr(1, sVal, "<span") ' look for another "<span"
Loop
    RemoveSpan = sVal
End Function

Im Nachhinein ist mir klar, dass ich dies effizienter hätte tun können, aber es funktioniert und ich mache weiter! 

0
Todd