- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2016-1-9 15:31
| 只看該作者
本帖最後由 GBKEE 於 2016-1-9 15:36 編輯
回復 2# stillfish00
回復 3# joey0415
綜合2位,使用表單呈現,可選擇地區,資料格式,時間. 匯入所要的氣象資料.
新增 UserForm(表單) 中加入ComboBox1, ComboBox2, ComboBox3 ,CommandButton1- Option Explicit
- Dim xObject()
- Private Sub UserForm_Initialize()
- xObject = Array(ComboBox1, ComboBox2, ComboBox3)
- 觀測查詢_設定
- Com
- ComboBox1.Value = ComboBox1.List(0)
- ComboBox2.Value = ComboBox2.List(0)
- End Sub
- Private Sub ComboBox1_Change() '測 站
- Com
- End Sub
- Private Sub ComboBox2_Change() '資料格式
- Dim i As Double
- With ComboBox3
- .Clear
- Select Case ComboBox2.ListIndex
- Case 0 '
- For i = Date - 1 To DateAdd("Q", -1, Date) Step -1
- .AddItem
- .List(.ListCount - 1) = Format(i, "YYYY-MM-DD")
- Next
- Case 1
- i = Date
- Do
- .AddItem
- .List(.ListCount - 1) = Format(i, "YYYY-MM")
- i = DateAdd("M", -1, i)
- Loop Until Year(i) < Year(Date) - 1
- Case 2
- For i = Year(Date) To Year(Date) - 1 Step -1
- .AddItem
- .List(.ListCount - 1) = i
- Next
- End Select
- If ComboBox2.ListIndex > -1 Then .Value = .List(0)
- End With
- Com
- End Sub
- Private Sub ComboBox3_Change() '時 間
- Com
- End Sub
- Private Sub Com() '
- Dim E As Variant
- With CommandButton1
- .Enabled = True
- For Each E In xObject
- If E.ListIndex = -1 Then .Enabled = False '按紐(觀測資料查詢):不可用
- Next
- End With
- End Sub
- Private Sub CommandButton1_Click() '按紐(觀測資料查詢)
- Dim surl As String, QT As QueryTable
- 'http://e-service.cwb.gov.tw/HistoryDataQuery/YearDataController.do?command=viewMain&station=467410&datepicker=2016
- 'http://e-service.cwb.gov.tw/HistoryDataQuery/MonthDataController.do?"
- 'http://e-service.cwb.gov.tw/HistoryDataQuery/DayDataController.do?
- surl = "URL; http://e-service.cwb.gov.tw/HistoryDataQuery/"
- Select Case ComboBox2.ListIndex
- Case 0
- surl = surl & "DayDataController.do?"
- Case 1
- surl = surl & "MonthDataController.do?"
- Case 2
- surl = surl & "YearDataController.do?"
- End Select
- surl = surl & "command=viewMain&station=" & ComboBox1.List(ComboBox1.ListIndex, 1)
- surl = surl & "&datepicker=" & ComboBox3
- With ActiveSheet
- .Cells.Delete
- Set QT = .QueryTables.Add(Connection:=surl, Destination:=.Range("$A$1"))
- With QT
- .WebFormatting = xlWebFormattingNone
- .Refresh BackgroundQuery:=False
- .Delete
- End With
- End With
- Set QT = Nothing
- End Sub
- Private Sub 觀測查詢_設定()
- Dim i As Double, E As Object, op As Object
- Dim oXmlhttp As Object, oHtmldoc As Object, Url As String
- Set oXmlhttp = CreateObject("msxml2.xmlhttp")
- Set oHtmldoc = CreateObject("htmlfile")
- Url = "http://e-service.cwb.gov.tw/HistoryDataQuery/QueryDataController.do?command=viewMain" '
- With oXmlhttp
- .Open "Get", Url, False
- .Send
- oHtmldoc.write .responseText
- End With
- With oHtmldoc
- Set E = .all.tags("SELECT")(0)
- Set op = .all.tags("option")
- End With
- For i = 0 To op.Length - 1
- If i <= E.Length - 1 Then
- With ComboBox1
- .AddItem
- .List(.ListCount - 1, 0) = op(i).innertext '測站:名稱
- .List(.ListCount - 1, 1) = op(i).Value '測站:數值
- End With
- Else
- With ComboBox2
- .AddItem
- .List(.ListCount - 1, 0) = op(i).innertext '資料格式:名稱
- End With
- End If
- Next
- End Sub
|
|
發表於 2016-1-7 10:09
| 
