麻辣家族討論版版 - Powered by Discuz! Board

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

複製代碼