- 帖子
- 6
- 主題
- 1
- 精華
- 0
- 積分
- 12
- 點名
- 0
- 作業系統
- WIN8
- 軟體版本
- OFFICE2016
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2015-12-9
- 最後登錄
- 2016-7-29
|
上網查音標英英解釋
剛剛爬了一下文
用錯的程式碼出現了VB編輯器
這樣我照著試試，成功了
請教前輩若是我想要插入一欄擷取英英的解釋要怎麼做呢？
例如從
http://www.oxfordlearnersdictionaries.com/definition/english/?q=
中擷取第一行英英解釋
我試著改動程式碼但沒有任何反應
Sub searchIT(rng As Range)
Dim XH As Object
Dim shpRm As Shape
Columns("B:B").Select
With Selection.Font
.Name = "Arial Unicode MS"
.Size = 12
End With
Range("a1").Select
Dim iurl, iurl2 As String
'清除已有的解釋及音標
iurl = "http://www.oxfordlearnersdictionaries.com/definition/english/?q="
iurl2 = "http://dict.tw/index.pl?query="
For Each rng In ActiveSheet.Range("a1", ActiveSheet.Range("a50").End(xlUp))
rng.Select
If rng.Value <> "" Then
rng.Select
Set XH = CreateObject("Microsoft.XMLHTTP")
With XH
.Open "get", iurl & rng, False
.send
' On Error Resume Next
'從Yahoo字典摘取第一組中文翻譯
If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
'摘取KK音標
If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
.Open "get", iurl2 & rng, False
.send
'從DICT.TW 英漢字典擷取字義
If InStr(.responseText, "</span><br /> ") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> ")(1), "<")(0)
End With
End If
Next
End Sub |
|
發表於 2015-12-9 15:19
| 
