上網查音標英英解釋

帖子: 1
主題: 0
精華: 0
積分: 1
點名: 0
作業系統: Windows 7
軟體版本: Office 2010
閱讀權限: 10
性別: 男
註冊時間: 2016-3-22
最後登錄: 2016-3-30

13^#

發表於 2016-3-22 16:31 | 只看該作者

我用上面的程式碼,上周大部份都可成功,但從上周六開始出現錯誤訊息,Run-time error '1004",請問高手,有好方法嗎? 下面二個平台版本,出現的狀況都一樣

Windows 7+office 2010
Windows 10+office 2010

brianhau

帖子: 6
主題: 1
精華: 0
積分: 12
點名: 0
作業系統: WIN8
軟體版本: OFFICE2016
閱讀權限: 10
性別: 男
註冊時間: 2015-12-9
最後登錄: 2016-7-29

12^#

發表於 2016-1-11 17:47 | 只看該作者

回復 11# c_c_lai

感謝！真的非常感謝你！
成功了！
我想您說的很清楚，但我看不大懂，需要好好消化一番！

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

11^#

發表於 2015-12-28 19:34 | 只看該作者

回復 8# brianhau

Option Explicit
Private oxmlhttp As Object
Private ohtml As Object
Sub Ex()
Dim txt As String
' txt = dictionary_oxford("simulation")
' MsgBox "simulation = " & txt
' searchITA ([A1])
searchIT ([A1])
End Sub
Function dictionary_oxford(word As String)
Dim colNodes As Object, bFound As Boolean, x As Variant
If oxmlhttp Is Nothing Then Set oxmlhttp = CreateObject("msxml2.xmlhttp")
If ohtml Is Nothing Then Set ohtml = CreateObject("htmlfile")
With oxmlhttp
.Open "get", "http://www.oxfordlearnersdictionaries.com/definition/english/" & word, False
.send
ohtml.body.innerhtml = .responseText
' <span class="def" ...
Set colNodes = ohtml.getElementsByTagName("span")
For Each x In colNodes
If x.className = "def" Then bFound = True: dictionary_oxford = x.innerText: Exit For
Next
If Not bFound Then dictionary_oxford = "# Not Found #"
End With
End Function
Function searchIT(rng As Range)
Dim XH As Object, shpRm As Shape
Dim iurl, iurl2 As String
Columns("B:B").Select
With Selection.Font
.Name = "Arial Unicode MS"
.Size = 12
End With
Range("B:J").Clear
' Range("a1").Select
rng.Select
' 清除已有的解釋及音標
iurl = "http://tw.dictionary.search.yahoo.com/search?p="
iurl2 = "http://dict.tw/index.pl?query="
For Each rng In ActiveSheet.Range("a1", ActiveSheet.Range("A" & Rows.Count).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字典摘取第一組中文翻譯
' rng.Offset(0, 20) = .responseText
rng.Offset(0, 20) = ""
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
rng.Offset(0, 9) = dictionary_oxford(rng.Value)
End If
Next
End Function
Function searchITA(rng As Range)
Dim XH As Object, shpRm As Shape
Dim iurl, iurl2 As String, x As Variant
Dim colNodes As Object, bFound As Boolean, oxford As String
Columns("B:B").Select
With Selection.Font
.Name = "Arial Unicode MS"
.Size = 12
End With
' 清除已有的解釋及音標
Range("B:J").Clear
' Range("a1").Select
rng.Select
iurl = "http://tw.dictionary.search.yahoo.com/search?p="
iurl2 = "http://dict.tw/index.pl?query="
For Each rng In ActiveSheet.Range("a1", ActiveSheet.Range("A" & Rows.Count).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
If oxmlhttp Is Nothing Then Set oxmlhttp = CreateObject("msxml2.xmlhttp")
If ohtml Is Nothing Then Set ohtml = CreateObject("htmlfile")
With oxmlhttp
.Open "get", "http://www.oxfordlearnersdictionaries.com/definition/english/" & rng, False
.send
ohtml.body.innerhtml = .responseText
' <span class="def" ...
Set colNodes = ohtml.getElementsByTagName("span")
For Each x In colNodes
If x.className = "def" Then bFound = True: oxford = x.innerText: Exit For
Next
If Not bFound Then oxford = "# Not Found #"
End With
rng.Offset(0, 9) = oxford
End If
Next
End Function

複製代碼

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

10^#

發表於 2015-12-28 18:53 | 只看該作者

回復 8# brianhau
如前面所述，你可以選擇執行
(A) searchIT ([A1]) 亦或是
(B) searchITA ([A1])。

(A) 模式係將函示分為兩個函式處裡不同內容：
A-1.  Function searchIT(rng As Range)
      從 Yahoo 字典摘取第一組 KK 音標、中文翻譯
A-2.  Function dictionary_oxford(word As String)
      抓取對應之牛津英辭解釋。
(B) 模式係將函示合而為一，以一個函式處裡 A-1 以及 A-2
不同作業內容：
B.  Function searchITA(rng As Range)

擇一執行，可依你個人喜好選擇，A 案係依處裡不同內容，而
有其各自的函式包裝，事後可依其它實務需求易於組合包裝；
B 案係為整合式函式。)

你可將程式全部置放於『模組 -> Module1』內，或是將 Ex()
單獨抽出來另放置在 ThisWorkbook 的程式碼區內；或者是
將所有程式碼全部裝置在  ThisWorkbook 的程式碼區內。

在程式碼最前面如果你加入了『Option Explicit』，
意即你宣告了所有使用之變數需應「事先加以宣告」的原因。
因為在 dictionary_oxford 函式並未宣告 x 的變數型態，
你只要加入型態宣告 (x As Variant) 即可。

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

9^#

發表於 2015-12-28 18:49 | 只看該作者

回復 8# brianhau
你目前的『模組』分別為 Module1、Module2、Module3，
以下是你目前程式放置的內容：
Module1 擺放的是 Function dictionary_oxford(word As String)，
Module2 擺放的是 Sub Ex() 測試模組 (主程式)，
Module3 擺放的是 Function searchIT(rng As Range)
你只要執行『模組 -> Module2 -> Ex』就行了。
或者是 (正式運作時)
你可以插入『Button』物件，指到你的『模組 -> Module2 -> Ex』。

brianhau

帖子: 6
主題: 1
精華: 0
積分: 12
點名: 0
作業系統: WIN8
軟體版本: OFFICE2016
閱讀權限: 10
性別: 男
註冊時間: 2015-12-9
最後登錄: 2016-7-29

8^#

發表於 2015-12-28 11:47 | 只看該作者

回復 6# c_c_lai
謝謝c_c_lai，非常感激！
我試著貼上程式碼，發現完全不會動作，是欠缺什麼步驟嗎？
再次謝謝您！

dict Eng.rar (12.03 KB)

brianhau

帖子: 6
主題: 1
精華: 0
積分: 12
點名: 0
作業系統: WIN8
軟體版本: OFFICE2016
閱讀權限: 10
性別: 男
註冊時間: 2015-12-9
最後登錄: 2016-7-29

7^#

發表於 2015-12-28 11:44 | 只看該作者

回復 4# stillfish00
謝謝stillfish00的回覆
但我還試試不出來...

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

6^#

發表於 2015-12-11 20:12 | 只看該作者

本帖最後由 c_c_lai 於 2015-12-14 07:33 編輯

回復 3# brianhau
亦可以援用原本的方式，即
使用分別之兩個自訂函式：

Private oxmlhttp As Object
Private ohtml As Object
Function dictionary_oxford(word As String)
Dim colNodes As Object, bFound As Boolean
If oxmlhttp Is Nothing Then Set oxmlhttp = CreateObject("msxml2.xmlhttp")
If ohtml Is Nothing Then Set ohtml = CreateObject("htmlfile")
With oxmlhttp
.Open "get", "http://www.oxfordlearnersdictionaries.com/definition/english/" & word, False
.send
ohtml.body.innerhtml = .responseText
' <span class="def" ...
Set colNodes = ohtml.getElementsByTagName("span")
For Each x In colNodes
If x.className = "def" Then bFound = True: dictionary_oxford = x.innerText: Exit For
Next
If Not bFound Then dictionary_oxford = "# Not Found #"
End With
End Function

複製代碼

Sub Ex()
Dim txt As String
' txt = dictionary_oxford("simulation")
' MsgBox "simulation = " & txt
searchIT ([A1])
End Sub

複製代碼

Function searchIT(rng As Range)
Dim XH As Object, shpRm As Shape
Dim iurl, iurl2 As String
Columns("B:B").Select
With Selection.Font
.Name = "Arial Unicode MS"
.Size = 12
End With
Range("B:J").Clear
Range("a1").Select
' 清除已有的解釋及音標
iurl = "http://tw.dictionary.search.yahoo.com/search?p="
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
rng.Offset(0, 9) = dictionary_oxford(rng.Value)
End If
Next
End Function

複製代碼

如此結果應該是你構想的方式了。

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

5^#

發表於 2015-12-11 19:34 | 只看該作者

本帖最後由 c_c_lai 於 2015-12-12 07:51 編輯

回復 3# brianhau
我將你的程式與 stillfish00 大大的程式碼
略加整合成你的需求：

Private oxmlhttp As Object
Private ohtml As Object
Function searchITA(rng As Range)
Dim XH As Object, shpRm As Shape
Dim iurl, iurl2 As String
Dim colNodes As Object, bFound As Boolean, oxford As String
Columns("B:B").Select
With Selection.Font
.Name = "Arial Unicode MS"
.Size = 12
End With
' 清除已有的解釋及音標
Range("B:J").Clear
Range("a1").Select
iurl = "http://tw.dictionary.search.yahoo.com/search?p="
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
If oxmlhttp Is Nothing Then Set oxmlhttp = CreateObject("msxml2.xmlhttp")
If ohtml Is Nothing Then Set ohtml = CreateObject("htmlfile")
With oxmlhttp
.Open "get", "http://www.oxfordlearnersdictionaries.com/definition/english/" & rng, False
.send
ohtml.body.innerhtml = .responseText
' <span class="def" ...
Set colNodes = ohtml.getElementsByTagName("span")
For Each x In colNodes
If x.className = "def" Then bFound = True: oxford = x.innerText: Exit For
Next
If Not bFound Then oxford = "# Not Found #"
End With
rng.Offset(0, 9) = oxford
End If
Next
End Function

複製代碼

Sub Ex()
searchITA ([A1])
End Sub

複製代碼