使用Excel VBA批量遍历工作表翻译单元格及文本框内容（西译英）

核心需求 #

• 将工作簿所有工作表中的单元格西班牙语文本翻译为英语
• 同时处理各工作表内的文本框（TextBox）内容
• 替换原TranslateCell宏中依赖Selection的逻辑，实现全自动化遍历

解决方案实现 #

1. 改造单元格翻译逻辑（遍历整个工作表）

移除对Selection的依赖，改为遍历指定工作表的所有已使用单元格，跳过空单元格和非文本内容，避免无效请求。

2. 新增文本框翻译逻辑

遍历工作表中的所有形状，识别标准文本框和ActiveX文本框两种类型，提取内容翻译后写回。

3. 主控制宏（遍历所有工作表）

统一调用单元格和文本框翻译逻辑，循环处理工作簿的每一个工作表。

完整VBA代码 #

Sub TranslateAllSheets()
    ' 遍历工作簿所有工作表，执行翻译
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        TranslateWorksheetCells ws
        TranslateWorksheetTextBoxes ws
    Next ws
    MsgBox "所有工作表翻译完成！", vbInformation
End Sub

Sub TranslateWorksheetCells(ws As Worksheet)
' 翻译指定工作表的所有已使用单元格（西→英）
    Dim getParam As String, trans As String, translateFrom As String, translateTo As String
    translateFrom = "es" ' 源语言：西班牙语
    translateTo = "en"   ' 目标语言：英语
    
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim cell As Range
    
    ' 遍历工作表中所有已使用的单元格
    For Each cell In ws.UsedRange.Cells
        ' 跳过空单元格或非文本内容
        If cell.Value <> "" And VarType(cell.Value) = vbString Then
            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
                ' 备用解析逻辑，适配网页结构变化
                On Error Resume Next
                cell.Value = Clean(CStr(Split(Split(objHTTP.responsetext, "<div class=""result-container"">")(1), "</div>")(0)))
                On Error GoTo 0
            End If
        End If
    Next cell
End Sub

Sub TranslateWorksheetTextBoxes(ws As Worksheet)
' 翻译指定工作表中所有文本框的内容（西→英）
    Dim getParam As String, trans As String, translateFrom As String, translateTo As String
    translateFrom = "es" ' 源语言：西班牙语
    translateTo = "en"   ' 目标语言：英语
    
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim shp As Shape
    
    ' 遍历工作表中所有形状
    For Each shp In ws.Shapes
        ' 判断是否为文本框类型（包含标准TextBox和ActiveX TextBox）
        If shp.Type = msoTextBox Or shp.Type = msoOLEControlObject Then
            Dim textBoxText As String
            ' 获取文本框内容
            If shp.Type = msoTextBox Then
                textBoxText = shp.TextFrame2.TextRange.Text
            Else
                ' 处理ActiveX文本框
                If shp.OLEFormat.Object.Object.TypeName = "TextBox" Then
                    textBoxText = shp.OLEFormat.Object.Object.Text
                End If
            End If
            
            ' 翻译非空文本
            If textBoxText <> "" Then
                getParam = ConvertToGet(textBoxText)
                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>")
                Else
                    On Error Resume Next
                    trans = Clean(CStr(Split(Split(objHTTP.responsetext, "<div class=""result-container"">")(1), "</div>")(0)))
                    On Error GoTo 0
                End If
                
                ' 将翻译结果写回文本框
                If shp.Type = msoTextBox Then
                    shp.TextFrame2.TextRange.Text = Clean(trans)
                Else
                    If shp.OLEFormat.Object.Object.TypeName = "TextBox" Then
                        shp.OLEFormat.Object.Object.Text = Clean(trans)
                    End If
                End If
            End If
        End If
    Next shp
End Sub

'----辅助函数----
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)
    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

使用说明 #

1. 打开目标Excel工作簿，按下Alt+F11打开VBA编辑器
2. 插入新模块，将上述代码粘贴进去
3. 运行TranslateAllSheets宏，等待翻译完成

注意事项 #

• 翻译依赖Google翻译网页接口，若网页结构更新，正则表达式可能需要调整
• 频繁请求可能触发平台限制，建议翻译大量内容时分批次执行
• 测试时可先在单个工作表验证功能，再批量执行

内容的提问来源于stack exchange，提问作者morsep66