发布网友 发布时间:2022-04-19 22:54
共4个回答
热心网友 时间:2023-09-02 11:43
之前搞过一个,包括多个翻译结果、音标、例句——网页返回结果中都有,甚至可以点击发音【音频文件从另一个网页获取】,等有空我找找
使用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.you.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.you.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.you.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
在工作表中,就像使用自带的函数一样:
之间给出字符串:
或者单元格引用:
热心网友 时间:2023-09-02 11:43
换个接口试试
热心网友 时间:2023-09-02 11:44
除非用数据库,否则很难自动推断出来追问=IF(A2="","",FILTERXML(WEBSERVICE("http://fanyi.you.com/translate?&i="&A2&"&doctype=xml"),"//translation"))追答看样子大概是改下//translation这个节点,改成其他的,
具体你要打开前面的xml才知道设置成哪个
热心网友 时间:2023-09-02 11:44
这个能不能利用百度翻译或者爱词霸的网页来实现自动获取,有道的网页好像返回数据变了