VBA Word / Excel Macro для перевода текста с помощью DeepL.com на заднем плане

Question

Я пытаюсь разработать макрос для автоматического перевода текста на другой язык в Word.Макрос выделяет весь текст и отправляет его в deepL, открывая IE и предоставляя перевод.

Я хочу попытаться получить перевод текста без копирования и вставки.Для этого у меня есть:

function (text2translate,langOrigin,langEnd)
...
Set IEapp = CreateObject("InternetExplorer.Application") 'Set IEapp =InternetExplorer
myAddress = "https://www.deepl.com/translator#" & langOrigin & "/" & langEnd & "/"
myAddress = myAddress & text2translate
WebUrl = myAddress
    With IEapp
        .Silent = True 'No Pop-ups
        .Visible = True 'Set InternetExplorer to Visible
        .Navigate WebUrl 'Load web page

        'Run and Wait, if you intend on passing variables at a later stage
        Do While .Busy
            DoEvents
        Loop

        Do While .ReadyState <> 4
            DoEvents
        Loop
        Set myHTML = .Document
    End With
...
end function

Пока все хорошо.Передает текст в новое открытое окно IE.Теперь я могу копировать и вставлять.

Я хотел бы сейчас пропустить эту последнюю копию и вставить и получить перевод непосредственно в слове (или Excel) в определенном месте.Первое, что я должен сделать, это присвоить перевод переменной.Что я не могу сделать.

Я пытаюсь:

theData = myHTML.getElementsByClassName("lmt__textarea lmt__target_textarea lmt__textarea_base_style dl_disabled")
    Dim mystring As String
    mystring = theData.innerText
    MsgBox mystring

Так как, согласно Firefox Developer Explorer, это имя элемента класса, в который вставлен трейслинг.Тем не менее, текст перевода не должен быть виден в коде HTML.Что странно.Как я могу видеть что-то в своем браузере, если оно не является частью HTML-кода?

В любом случае последняя часть не работает.

Некоторые идеи?

спасибо.

обновление 1: после хорошего ответа от @Andy похоже, что getElementsByClassName возвращает коллекцию, и я должен пройтись по этой коллекции.

Dim element As Variant
For Each element In theData
    myString = myString & element.innerText
Next

Я получаю сообщение об ошибке: Требуется объект в 'Для каждого элемента в данных' Почему?Спасибо 2

Answer 1

вот код для Excel VBA.вам не нужен DeepL.com, когда вы можете использовать Google:)

Option Explicit

#If Win64 Then '64?
    Private Declare PtrSafe Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As LongPtr, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#Else
    Private Declare Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As Long, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#End If

Public Sub Translate_Selection()
Dim IE As InternetExplorer
Dim URL As String
Dim Content As String
Dim SelectedRange As Range
Dim cel As Range
Dim celVal As String
Dim cmt As String
Dim ScriptEngine As ScriptControl
Set ScriptEngine = New ScriptControl

Call MsgBoxTimeout(0, "Please Wait for next pop-up message. Translation of selected range is in Progress.", "Translation In Progress", vbInformation, 0, 4000)

ScriptEngine.Language = "JScript"

ScriptEngine.AddCode "function encode(str) {return encodeURIComponent(str);}"
ScriptEngine.AddCode "function decode(str) {return decodeURIComponent(str);}"

Set SelectedRange = Application.Selection

    For Each cel In SelectedRange.Cells

        cel.Replace Chr(160), " ", xlPart

        cel.Value = Trim(Application.WorksheetFunction.Clean(cel.Value))
        Content = ""
        If cel.Value <> "" And cel.Value <> " " And cel.Value <> Empty Then
            Content = ScriptEngine.Run("encode", cel.Value)
            URL = "https://translate.google.com/#auto/en/" & Content
            'MsgBox URL
            Set IE = New InternetExplorer
            IE.Visible = False
            IE.Navigate URL
            Do Until IE.ReadyState = 4
                DoEvents
            Loop
            Application.Wait (Now + TimeValue("0:00:3"))
            Do Until IE.ReadyState = 4
                DoEvents
            Loop

            If Content <> "" And Content <> " " And IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText <> "" Then
                Content = IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText
                cel.Value = ScriptEngine.Run("decode", Content)
            End If
            IE.Quit
            Set IE = Nothing
        End If
        cmt = ""
        If Not cel.Comment Is Nothing Then
            cmt = ScriptEngine.Run("encode", cel.Comment.Text)
            URL = "https://translate.google.com/#auto/en/" & cmt
            Set IE = New InternetExplorer
            IE.Visible = False
            IE.Navigate URL
            Do Until IE.ReadyState = 4
                DoEvents
            Loop
            Application.Wait (Now + TimeValue("0:00:3"))
            Do Until IE.ReadyState = 4
                DoEvents
            Loop
            If cmt <> "" And cmt <> " " And IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText <> "" Then
                cmt = ScriptEngine.Run("decode", IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText)
                With cel
                    .ClearComments
                    .AddComment
                    .Comment.Text Text:=cmt
                End With
            End If
            IE.Quit
            Set IE = Nothing
        End If
    Next cel
    Call MsgBoxTimeout(0, "Done...", "Task Completed", vbInformation, 0, 2000)
End Sub
Public Sub Translate_Page()
    Dim IE As InternetExplorer
    Dim URL As String
    Dim Content As String
    Dim LastCol As Long
    Dim LastRow As Long
    Dim yLooper As Long
    Dim xLooper As Long
    Dim cmt As String
    Dim ScriptEngine As ScriptControl
    Set ScriptEngine = New ScriptControl




    ScriptEngine.Language = "JScript"

    ScriptEngine.AddCode "function encode(str) {return encodeURIComponent(str);}"
    ScriptEngine.AddCode "function decode(str) {return decodeURIComponent(str);}"

    With Application.ActiveSheet
        LastRow = .UsedRange.Rows.Count
        LastCol = .UsedRange.Columns.Count

    Call MsgBoxTimeout(0, "Please Wait for Next Pop-Up message. Translation of entire page is in progress. It will take approx." & (LastRow * LastCol * 3) / 60 & " minutes.", "Translation In Progress", vbInformation, 0, 8000)


        For yLooper = 1 To LastRow

            LastCol = .Cells(yLooper, Columns.Count).End(xlToLeft).Column
            For xLooper = 1 To LastCol
                .Cells(yLooper, xLooper).Replace Chr(160), " ", xlPart
                .Cells(yLooper, xLooper).Value = Trim(Application.WorksheetFunction.Clean(Cells(yLooper, xLooper).Value))
                .Cells(yLooper, xLooper).Select
                Content = ""
                If .Cells(yLooper, xLooper).Value <> "" And .Cells(yLooper, xLooper).Value <> " " And .Cells(yLooper, xLooper).Value <> Empty Then
                    Content = ScriptEngine.Run("encode", .Cells(yLooper, xLooper).Value)
                    URL = "https://translate.google.com/#auto/en/" & Content
                    Set IE = New InternetExplorer
                    IE.Visible = False
                    IE.Navigate URL
                    Do Until IE.ReadyState = 4
                        DoEvents
                    Loop
                    Application.Wait (Now + TimeValue("0:00:3"))
                    Do Until IE.ReadyState = 4
                        DoEvents
                    Loop
                    If Content <> "" And Content <> " " And IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText <> "" Then
                        Content = IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText
                        .Cells(yLooper, xLooper).Value = ScriptEngine.Run("decode", Content)

                    End If

                    IE.Quit
                    Set IE = Nothing
                End If

                cmt = ""
                If Not .Cells(yLooper, xLooper).Comment Is Nothing Then
                    cmt = ScriptEngine.Run("encode", .Cells(yLooper, xLooper).Comment.Text)
                    URL = "https://translate.google.com/#auto/en/" & cmt
                    Set IE = New InternetExplorer
                    IE.Visible = False
                    IE.Navigate URL
                    Do Until IE.ReadyState = 4
                        DoEvents
                    Loop
                    Application.Wait (Now + TimeValue("0:00:3"))
                    Do Until IE.ReadyState = 4
                        DoEvents
                    Loop
                    If cmt <> "" And cmt <> " " And IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText Then
                        cmt = ScriptEngine.Run("decode", IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText)
                        With .Cells(yLooper, xLooper)
                            .ClearComments
                            .AddComment
                            .Comment.Text Text:=cmt
                        End With
                    End If

                    IE.Quit
                    Set IE = Nothing
                End If

            Next xLooper
        Next yLooper


    End With

    Call MsgBoxTimeout(0, "Done...", "Task Completed", vbInformation, 0, 2000)

End Sub

Answer 2

Вы можете попробовать:

' add data to input box
myHTML.getElementsbyClassName("lmt__textarea lmt__source_textarea lmt__textarea_base_style")(0).Value = "que paso"

' wait for answer
Do While IE.ReadyState <> 4 Or IE.Busy
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")
Loop

' get answer
Set myHTML = IE.Document ' always reset .document after a change
theData = myHTML.getElementsByClassName("lmt__textarea lmt__target_textarea lmt__textarea_base_style")(0).innerText

(0) в конце коллекции указывает, что вы хотите первый элемент в коллекции.

Также не забывайте сбрасывать myHTML = IE.Document каждый разокно меняется

Я также посмотрел HTML в своем браузере Internet Explorer (не спрашиваю, почему я использую IE) и получил приведенные выше строки для имен классов.