- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
8#
發表於 2016-2-25 21:35
| 只看該作者
本帖最後由 GBKEE 於 2016-2-26 06:13 編輯
回復 7# sillykin
試試看
UserForm的程式碼
需制定如下的6個控制項
ComboBox0, ComboBox1, ComboBox2, ComboBox3, ComboBox4, Label1- Option Explicit
- Dim IE As Object, Combo_Ar(), xMsg As Boolean, xButton As Boolean, xRng As Range
- Private Sub UserForm_Initialize()
- 'ComboBox 控制項 -> 縣市'事務所名稱 '鄉鎮市區'段'小段
- Combo_Ar = Array(ComboBox0, ComboBox1, ComboBox2, ComboBox3, ComboBox4)
- Set IE = CreateObject("InternetExplorer.Application")
- Set xRng = [B11]
- Label1 = ""
- xRng.Resize(, 6) = ""
- With IE
- '.Visible = True '可不顯示IE
- .Navigate "http://www.land.moi.gov.tw/ngis/chhtml/query2.asp"
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- ComboBox_list 0
- End With
- End Sub
- Private Sub ComboBox_list(ByVal Op As Integer)
- '縣市'事務所名稱 '鄉鎮市區'段'小段 的選項內容導入ComboBox的list
- Dim xSelect As Object, i As Integer, x As Integer
- xMsg = True
- 'xButton = True
- For i = Op To UBound(Combo_Ar)
- With Combo_Ar(i)
- If i = Op And .ListCount = 0 Then
- Do
- Set xSelect = IE.Document.all.tags("SELECT")(i)
- Loop Until xSelect.Length > 0
- ' MsgBox .List(1)
- For x = 0 To xSelect.Length - 1
- .AddItem
- .List(.ListCount - 1, 0) = xSelect(x).innertext
- Next
- .ListIndex = 0
- ElseIf i = Op And .ListIndex > 0 Then
- Do
- Set xSelect = IE.Document.all.tags("SELECT")(i)
- Loop Until xSelect.Length > 0
- xSelect.selectedIndex = .ListIndex
- If Op <> UBound(Combo_Ar) Then
- xSelect.fireEvent ("onchange")
- Do While IE.Busy Or IE.readyState <> 4: DoEvents: Loop
- Do
- Set xSelect = IE.Document.all.tags("SELECT")(i + 1)
- Loop Until xSelect.Length > 0
- With Combo_Ar(i + 1)
- .Clear
- For x = 0 To xSelect.Length - 1
- .AddItem
- .List(.ListCount - 1, 0) = xSelect(x).innertext
- Next
- .ListIndex = 0
- End With
- End If
- ElseIf i > 0 Then
- If Combo_Ar(i - 1).ListIndex = 0 Or Combo_Ar(i - 1).ListCount = 0 Then
- .Clear
- End If
- End If
- If .ListCount = 0 Or .ListIndex = 0 Then xButton = False
- If UBound(Combo_Ar) = i And .ListCount > 0 Then
- If .ListCount = 2 And .List(1) = "" Then xButton = True
- If .ListCount = 2 And .List(1) <> "" And .ListIndex > 0 Then xButton = True
- If .ListCount > 2 And .ListIndex > 0 Then xButton = True
- End If
- End With
- Next
- If xButton Then
- button_Click
- Else
- xRng.Cells(1, 6) = ""
- Label1 = ""
- End If
- xMsg = False
- End Sub
- Private Sub ComboBox0_Change() '縣市
- If xMsg = False Then ComboBox_list 0
- xRng.Cells(1, 1) = ComboBox0.Value
- End Sub
- Private Sub ComboBox1_Change() '事務所名稱
- If xMsg = False Then ComboBox_list 1
- xRng.Cells(1, 2) = ComboBox1.Value
- End Sub
- Private Sub ComboBox2_Change() '鄉鎮市區
- If xMsg = False Then ComboBox_list 2
- xRng.Cells(1, 3) = ComboBox2.Value
- End Sub
- Private Sub ComboBox3_Change() '段
- If xMsg = False Then ComboBox_list 3
- xRng.Cells(1, 4) = ComboBox3.Value
- End Sub
- Private Sub ComboBox4_Change() '小段
- If xMsg = False Then ComboBox_list 4
- xRng.Cells(1, 5) = IIf(InStr(ComboBox4, "請選擇"), "", ComboBox4.Value)
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
- IE.Quit
- End Sub
- Private Sub button_Click() '查詢
- Dim xIObject As Object, E
- With IE
- Do
- Set xIObject = .Document.all.tags("INPUT")
- Loop Until Not xIObject Is Nothing
- For Each E In xIObject
- If E.Value = "查詢" And E.Type = "button" Then
- E.Click
- Exit For
- End If
- Next
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Do
- Set xIObject = .Document.all.tags("STRONG")(0)
- Loop Until Not xIObject Is Nothing
- End With
- E = xIObject.innertext
- Label1 = Split(xIObject.innertext, "：")(1)
- xRng.Cells(1, 6) = "'" & Split(xIObject.innertext, "：")(1)
- End Sub
|
|
發表於 2016-2-21 11:03
| 
