返回列表 上一主題 發帖

網頁查詢問題

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2016-2-23 15:35 | 顯示全部帖子
回復 1# sillykin
試試看
  1. Option Explicit
  2. Sub Ex_土地段名代碼查詢系統()
  3.     Dim i As Integer, E As Object, xTile, Ar, iR As Integer
  4.     With CreateObject("InternetExplorer.Application")
  5. '        .Visible = True
  6.         .Navigate "http://www.land.moi.gov.tw/ngis/chhtml/query2.asp"
  7.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  8.         For i = 0 To .document.all.tags("SELECT").Length - 1
  9.                 Set E = .document.all.tags("SELECT")(i)
  10.                 ReDim Ar(1 To E.Length - 1)
  11.                 For iR = 1 To E.Length - 1
  12.                     Ar(iR) = iR & Space(1) & E(iR).INNERTEXT
  13.                 Next
  14.                 Do
  15.                 xTile = InputBox(Join(Ar, vbLf), E(0).INNERTEXT & "  1-" & E.Length - 1, 1)
  16.                 If Val(xTile) = 0 Then MsgBox "離開程式": GoTo OU
  17.                 Loop Until Val(xTile) >= 1 And Val(xTile) <= E.Length - 1
  18.                  
  19.                  E.selectedIndex = Val(xTile)
  20.                 E.fireEvent ("onchange")
  21.                 Do While .Busy Or .readyState <> 4: DoEvents: Loop
  22.             Next
  23.             Do
  24.                 Set E = .document.all.tags("INPUT")
  25.             Loop Until Not E Is Nothing
  26.             For Each Ar In E
  27.                 If Ar.Value = "查詢" And Ar.Type = "button" Then
  28.                     Ar.Click
  29.                     Exit For
  30.                 End If
  31.             Next
  32.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  33.             Do
  34.                 Set E = .document.all.tags("STRONG")(0)
  35.             Loop Until Not E Is Nothing
  36.             
  37.              MsgBox E.INNERTEXT
  38. OU:
  39.         .Quit        '關閉網頁
  40.     End With
  41. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2016-2-23 20:39 | 顯示全部帖子
回復 3# sillykin

http://forum.twbts.com/tag.php?name=網頁元素
  1. 'MsgBox E.INNERTEXT
  2.          [B11]=E.INNERTEXT
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2016-2-25 21:35 | 顯示全部帖子
本帖最後由 GBKEE 於 2016-2-26 06:13 編輯

回復 7# sillykin
試試看
UserForm的程式碼
需制定如下的6個控制項
ComboBox0, ComboBox1, ComboBox2, ComboBox3, ComboBox4, Label1
  1. Option Explicit
  2. Dim IE As Object, Combo_Ar(), xMsg As Boolean, xButton As Boolean, xRng As Range
  3. Private Sub UserForm_Initialize()
  4.     'ComboBox 控制項 -> 縣市'事務所名稱 '鄉鎮市區'段'小段
  5.     Combo_Ar = Array(ComboBox0, ComboBox1, ComboBox2, ComboBox3, ComboBox4)
  6.     Set IE = CreateObject("InternetExplorer.Application")
  7.     Set xRng = [B11]
  8.     Label1 = ""
  9.     xRng.Resize(, 6) = ""
  10.     With IE
  11.         '.Visible = True '可不顯示IE
  12.         .Navigate "http://www.land.moi.gov.tw/ngis/chhtml/query2.asp"
  13.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  14.         ComboBox_list 0
  15.     End With
  16. End Sub
  17. Private Sub ComboBox_list(ByVal Op As Integer)
  18.     '縣市'事務所名稱 '鄉鎮市區'段'小段 的選項內容導入ComboBox的list
  19.     Dim xSelect As Object, i As Integer, x As Integer
  20.     xMsg = True
  21.     'xButton = True
  22.     For i = Op To UBound(Combo_Ar)
  23.         With Combo_Ar(i)
  24.             If i = Op And .ListCount = 0 Then
  25.                 Do
  26.                     Set xSelect = IE.Document.all.tags("SELECT")(i)
  27.                 Loop Until xSelect.Length > 0
  28.               ' MsgBox .List(1)
  29.                 For x = 0 To xSelect.Length - 1
  30.                     .AddItem
  31.                     .List(.ListCount - 1, 0) = xSelect(x).innertext
  32.                 Next
  33.                 .ListIndex = 0
  34.             ElseIf i = Op And .ListIndex > 0 Then
  35.                 Do
  36.                     Set xSelect = IE.Document.all.tags("SELECT")(i)
  37.                 Loop Until xSelect.Length > 0
  38.                 xSelect.selectedIndex = .ListIndex
  39.                 If Op <> UBound(Combo_Ar) Then
  40.                     xSelect.fireEvent ("onchange")
  41.                     Do While IE.Busy Or IE.readyState <> 4: DoEvents: Loop
  42.                     Do
  43.                         Set xSelect = IE.Document.all.tags("SELECT")(i + 1)
  44.                     Loop Until xSelect.Length > 0
  45.                     With Combo_Ar(i + 1)
  46.                         .Clear
  47.                         For x = 0 To xSelect.Length - 1
  48.                             .AddItem
  49.                             .List(.ListCount - 1, 0) = xSelect(x).innertext
  50.                         Next
  51.                         .ListIndex = 0
  52.                     End With
  53.                 End If
  54.             ElseIf i > 0 Then
  55.                 If Combo_Ar(i - 1).ListIndex = 0 Or Combo_Ar(i - 1).ListCount = 0 Then
  56.                     .Clear
  57.                 End If
  58.             End If
  59.             If .ListCount = 0 Or .ListIndex = 0 Then xButton = False
  60.             If UBound(Combo_Ar) = i And .ListCount > 0 Then
  61.                 If .ListCount = 2 And .List(1) = "" Then xButton = True
  62.                 If .ListCount = 2 And .List(1) <> "" And .ListIndex > 0 Then xButton = True
  63.                 If .ListCount > 2 And .ListIndex > 0 Then xButton = True
  64.             End If
  65.         End With
  66.     Next
  67.     If xButton Then
  68.         button_Click
  69.     Else
  70.         xRng.Cells(1, 6) = ""
  71.         Label1 = ""
  72.     End If
  73.     xMsg = False
  74. End Sub
  75. Private Sub ComboBox0_Change()      '縣市
  76.      If xMsg = False Then ComboBox_list 0
  77.      xRng.Cells(1, 1) = ComboBox0.Value
  78. End Sub
  79. Private Sub ComboBox1_Change()      '事務所名稱
  80.     If xMsg = False Then ComboBox_list 1
  81.     xRng.Cells(1, 2) = ComboBox1.Value
  82. End Sub
  83. Private Sub ComboBox2_Change()      '鄉鎮市區
  84.     If xMsg = False Then ComboBox_list 2
  85.     xRng.Cells(1, 3) = ComboBox2.Value
  86. End Sub
  87. Private Sub ComboBox3_Change()      '段
  88.     If xMsg = False Then ComboBox_list 3
  89.     xRng.Cells(1, 4) = ComboBox3.Value
  90. End Sub
  91. Private Sub ComboBox4_Change()      '小段
  92.     If xMsg = False Then ComboBox_list 4
  93.     xRng.Cells(1, 5) = IIf(InStr(ComboBox4, "請選擇"), "", ComboBox4.Value)
  94. End Sub
  95. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  96.     IE.Quit
  97. End Sub
  98. Private Sub button_Click() '查詢
  99.     Dim xIObject As Object, E
  100.     With IE
  101.         Do
  102.             Set xIObject = .Document.all.tags("INPUT")
  103.         Loop Until Not xIObject Is Nothing
  104.         For Each E In xIObject
  105.             If E.Value = "查詢" And E.Type = "button" Then
  106.                 E.Click
  107.                 Exit For
  108.             End If
  109.         Next
  110.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  111.         Do
  112.             Set xIObject = .Document.all.tags("STRONG")(0)
  113.         Loop Until Not xIObject Is Nothing
  114.     End With
  115.     E = xIObject.innertext
  116.     Label1 = Split(xIObject.innertext, "：")(1)
  117.     xRng.Cells(1, 6) = "'" & Split(xIObject.innertext, "：")(1)
  118. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2016-2-26 06:19 | 顯示全部帖子
回復 10# sillykin
抱歉程式碼沒貼齊全,原程式碼以更新
UserForm模組頂端的變數宣告(這模組的SUB(程序)皆可使用)
  1. Option Explicit
  2. Dim IE As Object, Combo_Ar(), xMsg As Boolean, xButton As Boolean, xRng As Range
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2016-2-27 06:51 | 顯示全部帖子
回復 15# sillykin
IE8,2003 執行你的附檔,沒有錯誤
請在表單模組上按F8逐步執行程式碼,看錯誤點在哪裡.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
返回列表 上一主題