用excel上網查音標

自我感覺良好

http://gb.twbts.com/index.php?topic=11456.10


http://www.boxcn.net/shared/77cyt18g34
crdotlin 版主做的。

舊版的excel主題: 單字(詞)學習工具 曾討論過的,用excel上網查音標。
只是現在yahoo的網頁改變了
請問現在要怎麼用呢!

c_c_lai

回復 1# 自我感覺良好
回復 2# Hsieh
回復 6# GBKEE

1. Option Explicit
   
2. 
   
3. Sub searchIT(Rng As Range)
   
4.     Dim XH As Object
   
5.     Dim shpRm As Shape
   
6.    
   
7.     '  清除已有的解釋及音標
   
8.     With Rng.EntireRow
   
9.         .Resize(1, .Columns.Count - 1).Offset(0, 1).Clear
   
10.     End With
    
11.    
    
12.     '  開啟網頁
    
13.     Set XH = CreateObject("Microsoft.XMLHTTP")
    
14.     With XH
    
15.         .Open "get", "http://tw.dictionary.search.yahoo.com/search?p=" & Rng.Text, False
    
16.         .send
    
17.         On Error Resume Next
    
18.         '  摘取第一組中文翻譯
    
19.         '  Rng.Offset(0, 2) = Split(Split(.responseText, "class=""description""><p>1.")(1), "<")(0)
    
20.         If InStr(.responseText, "><h4>1.") > 0 Then Rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
    
21.         '  摘取KK音標
    
22.         '  Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span>  ")(1), InStr(VBA.Split(.responseText, "KK</span>  ")(1), "]"))
    
23.         '  Rng.Offset(0, 1) = Split((Split(.responseText, "KK</span>")(1)), "<span>")(0)
    
24.         If InStr(.responseText, ">KK[") > 0 Then Rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
    
25.     End With
    
26.    
    
27.     Rng.Select
    
28. End Sub
    
29. 
    
30. Sub Ex()
    
31.     Dim Rng As Range
    
32.    
    
33.     For Each Rng In ActiveSheet.Range("A1", ActiveSheet.Range("A" & Rows.Count).End(xlUp))
    
34.         Rng.Select
    
35.         If Rng.Value <> "" Then
    
36.             searchIT Rng
    
37.         End If
    
38.     Next
    
39. End Sub

複製代碼

jimjim

我也是一樣的問題 卡在send,請問如何處理

mmxxxx

回復 9# wufonna


我也是相同問題，使用環境Win 7, MS Office 2010.
好可惜，功能很棒，請大大協助。

wufonna

回復 2# Hsieh


    請問 版主如下錯誤是如何，謝謝

下載 (42.3 KB)

2014-11-17 14:25

下載 (26.17 KB)

2014-11-17 14:26

james123

看起來是一個好玩的軟體~~
載來玩玩

dechiuan999

謝謝版主大大。
已測試可以應用了。
希望借用此功能可以
讓自已的英文有所進步。

感恩大大！

GBKEE

回復 6# dechiuan999
2樓    摘取KK音標  這行程式碼
          Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span>  ")(1), InStr(VBA.Split(.responseText, "KK</span>  ")(1), "]"))
         修改為
         Rng.Offset(0, 1) = Split((Split(.responseText, "KK</span>")(1)), "<span>")(0)

dechiuan999

各位大大好：

    又有一個學習英文的
好工具，小弟要好好多加
運用。可是小弟在學習過程
中一直無法顯示其音標。
請問其原因為何呢？

感恩各位大大！

uncle

回復 2# Hsieh


    我是新會員還不能下載檔案。小弟不才，請問這些代碼要如何使用?