ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

¤Wºô¬d­µ¼Ð­^­^¸ÑÄÀ

¦^´_ 8# brianhau
  1. Option Explicit

  2. Private oxmlhttp As Object
  3. Private ohtml As Object

  4. Sub Ex()
  5.     Dim txt As String
  6.    
  7.     '  txt = dictionary_oxford("simulation")
  8.     '  MsgBox "simulation = " & txt
  9.     '  searchITA ([A1])
  10.     searchIT ([A1])
  11. End Sub

  12. Function dictionary_oxford(word As String)
  13.     Dim colNodes As Object, bFound As Boolean, x As Variant
  14.         
  15.     If oxmlhttp Is Nothing Then Set oxmlhttp = CreateObject("msxml2.xmlhttp")
  16.     If ohtml Is Nothing Then Set ohtml = CreateObject("htmlfile")
  17.    
  18.     With oxmlhttp
  19.         .Open "get", "http://www.oxfordlearnersdictionaries.com/definition/english/" & word, False
  20.         .send
  21.         ohtml.body.innerhtml = .responseText
  22.         
  23.         '  <span class="def" ...
  24.         Set colNodes = ohtml.getElementsByTagName("span")
  25.         For Each x In colNodes
  26.             If x.className = "def" Then bFound = True: dictionary_oxford = x.innerText: Exit For
  27.         Next
  28.         If Not bFound Then dictionary_oxford = "# Not Found #"
  29.     End With
  30. End Function

  31. Function searchIT(rng As Range)
  32.     Dim XH As Object, shpRm As Shape
  33.     Dim iurl, iurl2 As String
  34.      
  35.     Columns("B:B").Select
  36.     With Selection.Font
  37.          .Name = "Arial Unicode MS"
  38.          .Size = 12
  39.     End With
  40.    
  41.     Range("B:J").Clear
  42.     '  Range("a1").Select
  43.     rng.Select
  44.     '  ²M°£¤w¦³ªº¸ÑÄÀ¤Î­µ¼Ð
  45.     iurl = "http://tw.dictionary.search.yahoo.com/search?p="
  46.     iurl2 = "http://dict.tw/index.pl?query="
  47.     For Each rng In ActiveSheet.Range("a1", ActiveSheet.Range("A" & Rows.Count).End(xlUp))
  48.         rng.Select
  49.         If rng.Value <> "" Then
  50.             rng.Select
  51.             Set XH = CreateObject("Microsoft.XMLHTTP")
  52.             With XH
  53.                 .Open "get", iurl & rng, False
  54.                 .send
  55.                 '  On Error Resume Next
  56.                 '  ±qYahoo¦r¨åºK¨ú²Ä¤@²Õ¤¤¤å½Ķ
  57.                 '  rng.Offset(0, 20) = .responseText
  58.                 rng.Offset(0, 20) = ""
  59.                 If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
  60.                 '  ºK¨úKK­µ¼Ð
  61.                 If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
  62.                 .Open "get", iurl2 & rng, False
  63.                 .send
  64.                 '  ±qDICT.TW ­^º~¦r¨åÂ^¨ú¦r¸q
  65.                 If InStr(.responseText, "</span><br /> &nbsp;") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
  66.             End With
  67.             rng.Offset(0, 9) = dictionary_oxford(rng.Value)
  68.         End If
  69.     Next
  70. End Function

  71. Function searchITA(rng As Range)
  72.     Dim XH As Object, shpRm As Shape
  73.     Dim iurl, iurl2 As String, x As Variant
  74.     Dim colNodes As Object, bFound As Boolean, oxford As String
  75.      
  76.     Columns("B:B").Select
  77.     With Selection.Font
  78.          .Name = "Arial Unicode MS"
  79.          .Size = 12
  80.     End With
  81.     '  ²M°£¤w¦³ªº¸ÑÄÀ¤Î­µ¼Ð
  82.     Range("B:J").Clear
  83.     '  Range("a1").Select
  84.     rng.Select
  85.      
  86.     iurl = "http://tw.dictionary.search.yahoo.com/search?p="
  87.     iurl2 = "http://dict.tw/index.pl?query="
  88.     For Each rng In ActiveSheet.Range("a1", ActiveSheet.Range("A" & Rows.Count).End(xlUp))
  89.         rng.Select
  90.         If rng.Value <> "" Then
  91.             rng.Select
  92.             Set XH = CreateObject("Microsoft.XMLHTTP")
  93.             With XH
  94.                 .Open "get", iurl & rng, False
  95.                 .send
  96.                 '  On Error Resume Next
  97.                 '  ±qYahoo¦r¨åºK¨ú²Ä¤@²Õ¤¤¤å½Ķ
  98.                 If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
  99.                 '  ºK¨úKK­µ¼Ð
  100.                 If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
  101.                 .Open "get", iurl2 & rng, False
  102.                 .send
  103.                 '  ±q DICT.TW ­^º~¦r¨åÂ^¨ú¦r¸q
  104.                 If InStr(.responseText, "</span><br /> &nbsp;") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
  105.             End With
  106.             If oxmlhttp Is Nothing Then Set oxmlhttp = CreateObject("msxml2.xmlhttp")
  107.             If ohtml Is Nothing Then Set ohtml = CreateObject("htmlfile")
  108.    
  109.             With oxmlhttp
  110.                 .Open "get", "http://www.oxfordlearnersdictionaries.com/definition/english/" & rng, False
  111.                 .send
  112.                 ohtml.body.innerhtml = .responseText
  113.         
  114.                 '  <span class="def" ...
  115.                 Set colNodes = ohtml.getElementsByTagName("span")
  116.                 For Each x In colNodes
  117.                     If x.className = "def" Then bFound = True: oxford = x.innerText: Exit For
  118.                 Next
  119.                 If Not bFound Then oxford = "# Not Found #"
  120.            End With
  121.            rng.Offset(0, 9) = oxford
  122.         End If
  123.     Next
  124. End Function
½Æ»s¥N½X

TOP

¦^´_ 11# c_c_lai


    ·PÁ¡I¯uªº«D±`·PÁ§A¡I
¦¨¥\¤F¡I
§Ú·Q±z»¡ªº«Ü²M·¡¡A¦ý§Ú¬Ý¤£¤jÀ´¡A»Ý­n¦n¦n®ø¤Æ¤@µf¡I

TOP

§Ú¥Î¤W­±ªºµ{¦¡½X,¤W©P¤j³¡¥÷³£¥i¦¨¥\,¦ý±q¤W©P¤»¶}©l¥X²{¿ù»~°T®§,Run-time error '1004",½Ð°Ý°ª¤â,¦³¦n¤èªk¶Ü? ¤U­±¤G­Ó¥­¥xª©¥»,¥X²{ªºª¬ªp³£¤@¼Ë

Windows 7+office 2010
Windows 10+office 2010

TOP

        ÀR«ä¦Û¦b : ¦³®É·í«äµL®É­W¡A¦n¤Ñ­n¿n«B¨Ó³¡C
ªð¦^¦Cªí ¤W¤@¥DÃD