Translating & Replacing Text Box Content From Spanish to English Using VBA (Excel Macro)

Question

I am looking to translate Excel workbook files with some content in cells and other content in text box objects placed throughout each sheet as efficiently as possible. I've found some great examples for creating VBA macros to translate text in cells, but these don't work for text within the text boxes.

It would also be awesome if someone could figure out how to run my TranslateCell macro below and the new text box translate macro across all the sheets in a workbook. Some of these files have up to 70 sheets so having to manually select cells/objects on each sheet to translate is still pretty time consuming.

I created the macro below for translating text in cells using the example from "David Iracheta" in his post with adjustments from "Foxfire And Burns Burns" Google Translate Using VBA - (Excel Macro) Issue. Pretty sure I need to at least change the "Set cell = Selection" and most other references to cells throughout the macro to make a version that does the same for text in text box objects, but I'm too inexperienced to figure it out on my own.

Sub TranslateCell()
'English Spanish Translator Using Google Translate
    Dim getParam As String, trans As String, translateFrom As String, translateTo As String
'In translateFrom we will select the language from which we will translate E.g. "es" = Spanish
    translateFrom = "es"
'In translateTo we select the language that we want to translate to. "en" = English
    translateTo = "en"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim r As Range, cell As Range
    Set cell = Selection
    For Each cell In Selection.Cells
        getParam = ConvertToGet(cell.Value)
        URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
        objHTTP.Open "GET", URL, False
        objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        objHTTP.send ("")
        If InStr(objHTTP.responsetext, "div dir=""ltr""") > 0 Then
            trans = RegexExecute(objHTTP.responsetext, "div[^""]*?""ltr"".*?>(.+?)</div>")
            cell.Value = Clean(trans)
        Else
            cell.Value = Clean(CStr(Split(Split(objHTTP.responsetext, "<div class=""result-container"">")(1), "</div>")(0)))
            'MsgBox ("Error")
        End If
    Next cell
End Sub
 
'----Functions Used----
Function ConvertToGet(val As String)
    val = Replace(val, " ", "+")
    val = Replace(val, vbNewLine, "+")
    val = Replace(val, "(", "%28")
    val = Replace(val, ")", "%29")
    ConvertToGet = val
End Function

Function Clean(val As String)
    val = Replace(val, "&quot;", """")
    val = Replace(val, "%2C", ",")
    val = Replace(val, "&#39;", "'")
    Clean = val
End Function

Public Function RegexExecute(str As String, reg As String, _
                             Optional matchIndex As Long, _
                             Optional subMatchIndex As Long) As String
    On Error GoTo ErrHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
    regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For greater efficiency.
    If regex.test(str) Then
        Set matches = regex.Execute(str)
        RegexExecute = matches(matchIndex).SubMatches(subMatchIndex)
        Exit Function
    End If
ErrHandl:
    RegexExecute = CVErr(xlErrValue)
End Function

Answer 1

You need to break down your code a little to make the "Translate" a function which just translates the text passed to it.

Example:

Option Explicit

Const FROM_LANG As String = "es"
Const TO_LANG As String = "en"


Sub TranslateActiveWorkbook()
    Dim wb As Workbook, ws As Worksheet, shp As Object
    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets              'loop all worksheets
        TranslateRange ws.Range("C15:C23")    'specific range
        TranslateRange ws.Range("C26:F34")
        For Each shp In ws.Shapes             'check objects on sheet
            'If TypeName(shp) = "TextBox" Then
            If TypeName(shp) = "Shape" Then '###
                TranslateTextShape shp
            End If
        Next shp
    Next ws
End Sub

'loop each cell in `rng` and translate if needed
Sub TranslateRange(rng As Range)
    Dim c As Range, v
    For Each c In rng.Cells
        v = c.Value
        If TranslateThis(v) Then
            c.Value = Translate(v)
        End If
    Next c
End Sub

'Translate text in a shape
Sub TranslateTextShape(shp As Shape)
    Dim v
    With shp.TextFrame2
        If .HasText Then         'is there any text?
            v = .textRange.Text
            If TranslateThis(v) Then .Text = Translate(v)
        End If
    End With
End Sub


'----Functions Used----
Function Translate(ByVal txt As String) As String
'English Spanish Translator Using Google Translate
    Dim getParam As String, trans As String, objHTTP As Object, url As String
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    getParam = Application.EncodeURL(txt) '#######
    url = "https://translate.google.pl/m?hl=" & FROM_LANG & "&sl=" & FROM_LANG & _
          "&tl=" & TO_LANG & "&ie=UTF-8&prev=_m&q=" & getParam
    objHTTP.Open "GET", url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send
    If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
        trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
        Translate = Clean(trans)
    Else
        Translate = Clean(CStr(Split(Split(objHTTP.responseText, "<div class=""result-container"">")(1), "</div>")(0)))
    End If
End Function
 
'does this look like something to translate?
Function TranslateThis(v) As Boolean
    If Not IsError(v) Then
        If Len(v) > 0 Then
            If Not IsNumeric(v) Then
                v = Trim(v)
                TranslateThis = Len(v) > 0
            End If
        End If
    End If
End Function

Function Clean(val As String)
    val = Replace(val, "&quot;", """")
    val = Replace(val, "%2C", ",")
    val = Replace(val, "&#39;", "'")
    Clean = val
End Function

Public Function RegexExecute(str As String, reg As String, _
                             Optional matchIndex As Long, _
                             Optional subMatchIndex As Long) As String
    On Error GoTo ErrHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
    regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For greater efficiency.
    If regex.test(str) Then
        Set matches = regex.Execute(str)
        RegexExecute = matches(matchIndex).SubMatches(subMatchIndex)
        Exit Function
    End If
ErrHandl:
    RegexExecute = CVErr(xlErrValue)
End Function

This just handles Range/Shape, bit you could add methods to translate text in other objects which might be found on a sheet.

FYI if you really need to do much of this type of thing, then setting up an account so you can call the Google Translate API instead of using this workaround would probably be worth it. It's not very costly - eg see https://cloud.google.com/translate/pricing#basic-pricing