我正在尝试翻译 Excel 工作簿文件，其中包含放置在每个工作表中的单元格和文本框对象中的内容。
我找到了翻译单元格中文本的示例，但没有找到文本框的示例。
如何在工作簿中的所有工作表上运行下面的 TranslateCell 宏以及新的文本框翻译宏？
其中一些文件多达 70 张，因此手动选择每张纸上的单元格/对象进行翻译非常耗时。
我使用“David Iracheta”在他的帖子中的示例创建了下面的宏，并根据“Foxfire And Burns Burns”进行了调整，用于翻译单元格中的文本使用 VBA 进行谷歌翻译 -（Excel 宏）问题。
很确定我至少需要更改
Set cell = SelectionSub 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, """, """")
val = Replace(val, "%2C", ",")
val = Replace(val, "'", "'")
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
您需要稍微分解一下代码，使“翻译”成为一个仅翻译传递给它的文本的函数。
示例：
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 .textRange.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, """, """")
val = Replace(val, "%2C", ",")
val = Replace(val, "'", "'")
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
这仅处理范围/形状，您可以添加方法来翻译可能在工作表上找到的其他对象中的文本。
仅供参考，如果您确实需要做很多此类事情，那么设置一个帐户以便您可以调用 Google Translate API 而不是使用此解决方法可能是值得的。 这不是很昂贵 - 例如参见 https://cloud.google.com/translate/pricing#basic-pricing