有道云翻译下载手机版

之前搞过一个，包括多个翻译结果、音标、例句——网页返回结果中都有，甚至可以点击发音【音频文件从另一个网页获取】，等有空我找找

使用VBA，需要添加引用：XML和HTML【注：今天测试，代码不能运行了，测试发现是有道网页返回的内容变了，解析路径不对了~~，音标的内容好像也没有了！！以下代码仅供参考吧】

右击工作表，查看代码，粘贴以下代码：

Sub FanYi(Wrd As String, Target As Range)

Author： cnbubble，03jb@163.com

版本1——使用有道获取翻译意思、音标、例句；从http://www.dictionary.com/获得MP3发音文件。【发音的代码未复制】

Dim xlmDoc As DOMDocument

Dim xlmNodes As IXMLDOMNodeList

Dim S As String, i As IXMLDOMNode, J As Integer, tagPos As Integer

Dim oExec

Wrd = Trim(Wrd)

If Wrd = Then Exit Sub

oExec = CreateObject( Wscript.shell ).Run( ping dict.youdao.com -n 1 , 0, True)

If oExec <> 0 Then Target.Offset(0, 1).Value = 可能未联网，翻译功能不可用！ : Exit Sub

Application.EnableEvents = False

Set xlmDoc = New DOMDocument

xlmDoc.async = False

If xlmDoc.Load( http://dict.youdao.com/search?q= & Wrd & &doctype=xml ) Then

Set xlmNodes = xlmDoc.SelectNodes( //translation/content ) 翻译内容

S =

For Each i In xlmNodes

S = S & i.Text & vbCrLf

Next

Target.Offset(0, 1).Value = Left(S, Len(S) - 2)

Set xlmNodes = xlmDoc.SelectNodes( //phonetic-symbol ) 音标

S =

For Each i In xlmNodes

S = S & / & i.Text & / & vbCrLf

Next

Target.Offset(0, 2).Value = Left(S, Len(S) - 2)

Target.Offset(0, 2).Font.Color = -11489280

Set xlmNodes = xlmDoc.SelectNodes( //example-sentences/sentence-pair ) 例句

J = 3

For Each i In xlmNodes

S = i.childNodes(0).Text & vbCrLf & i.childNodes(2).Text

tagPos = InStr(S, <b> )

S = Replace(S, <b> , )

S = Replace(S, </b> , )

With Target.Offset(0, J)

.Value = S

.Characters(tagPos, Len(Wrd)).Font.Bold = True

.Characters(tagPos, Len(Wrd)).Font.Color = vbRed

End With

J = J + 1

Next

End If

Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column > 1 Or Target.Row = 1 Or Target.Cells.Count > 1 Then Exit Sub

Call FanYi(Target.Value, Target)

End Sub

在A列输入要翻译的词，自动在后面显示所有的翻译结果、音标、三个例句，这是之前实现的。现在不运行了！！。

如果只实现音标，可以从网页获取：VBA，插入一个模块，粘贴下面的代码：

Public Function getPhon(Wrd As String) As String

查询一个单词的音标

Dim htmlDoc As String, sPhon As String

Dim oMatch

With CreateObject( Microsoft.XMLHTTP )

.Open GET , http://dict.youdao.com/search?q= & Wrd, False

.send

htmlDoc = .responseText

End With

With CreateObject( VBScript.RegExp )

.Global = False

.Pattern = <span class= phonetic >([^<]+)</span>

Set oMatch = .Execute(htmlDoc)

If oMatch.Count > 0 Then

getPhon = oMatch(0).submatches(0)

End If

End With

End Function

在工作表中，就像使用自带的函数一样：

之间给出字符串：

或者单元格引用：