Word макрос для перевода

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

Cowboy

 

Сообщения: 1430

Зарегистрирован: Чт сен 08, 2005 10:40

Откуда: Казахстан, пос. Иргиз

Язык(-и): английский <> русский

• Сайт
• ICQ

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

Ronny

 

Сообщения: 123

Зарегистрирован: Пт сен 21, 2007 14:11

Язык(-и): eng-rus

• Сайт
• ICQ

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

Ronny

 

Сообщения: 123

Зарегистрирован: Пт сен 21, 2007 14:11

Язык(-и): eng-rus

• Сайт
• ICQ

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

Руст

 

Сообщения: 722

Зарегистрирован: Вт авг 30, 2005 10:54

Язык(-и): Английский — русский

• Сайт

medvedeff

 

Сообщения: 7

Зарегистрирован: Пн окт 05, 2009 08:47

Откуда: Европа

Блог: Просмотр блога (2)

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

LyuFi

 

Сообщения: 18

Зарегистрирован: Вт авг 26, 2008 16:16

• Сайт

Я пытаюсь разработать макрос для автоматического перевода текста на другой язык в Word. Макрос выбирает весь текст и отправляет его глубоко, открывая 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. Теперь я могу копировать и вставлять.

Теперь я хотел бы пропустить эту последнюю копию и вставить и получить перевод, непосредственно вставленный в word (или 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, это имя элемента класса, в который встроен перевод. Тем не менее, текст перевода не отображается в HTML-коде. Что странно. Как я могу увидеть что-то в моем браузере, если это не является частью HTML-кода?

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

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

Благодарю.

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

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

Я получаю сообщение об ошибке: «Объект, необходимый для каждого элемента в данных». Почему? Спасибо 2

Вот код для 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

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

' 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) и получил указанные выше строки для имен классов.

В коде макроса используется формула с ключом CardText. Но у этого ключа есть ограничение — максимальное число не может быть больше 999.999 (см. заметку

Ключ CardText и его ограничения

). Поэтому автор макроса идет на хитрость и объединяет поля.

Но в английском языке нет склонений и результат для преобразованного числа получается правильным для чисел свыше 1.000.000 — используется слово «million». В русском языке итоговый результат будет выглядеть не очень красиво. Поэтому я чуть-чуть подредактировал макрос, заменив слово «million» на «миллион(а/ов)». Тоже не совсем нормально но, по крайней мере, не так режет глаз грамматической неправильностью.