- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
32#
發表於 2014-1-26 18:02
| 只看該作者
本帖最後由 GBKEE 於 2014-1-28 07:00 編輯
回復 31# pollllopkimo - Option Explicit
- Sub 公開資訊網頁()
- Dim A As Object, E As Object, Sh As Worksheet
- Set Sh = Sheets("sheet1") '物件: 指定工作表
- Sh.Activate
- With CreateObject("InternetExplorer.Application")
- '.Visible = True
- ' .Navigate "http://mops.twse.com.tw/mops/web/t164sb04" '網址:綜合損益表
- .Navigate "http://mops.twse.com.tw/mops/web/stapap1" '網址:董監事持股餘額明細資
- Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
- .document.getElementById("isnew").Value = "false" '選擇: 歷史資料
- '註解上一行程式碼為 -> 選擇: 最新資料,不會執行 If 內程式碼
-
- If .document.getElementById("isnew").Value = "false" Then
- .document.getElementById("isnew").FireEvent ("onchange")
- .document.getElementById("year").Value = Sh.Range("C1") '年度
- '.document.getElementById("season").Value = "01" '綜合損益表:第1季(季別)
- .document.getElementById("month").Value = Format(Sh.Range("D1"), "00") '董監事持股餘額明細資料:月份
- End If
- '********************************************************************
- For Each A In .document.getelementSbyTAGNAME("INPUT")
-
- If A.Name = "co_id" Then A.Value = Sh.Range("b1") '股票代號
-
-
- If A.Value = " 搜尋 " Then A.Click '按下 搜尋
- Next
- Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
- For Each E In .document.ALL.TAGS("div")
- If E.ID = "table01" Then
- .document.body.innerHTML = E.outerHTML
- .ExecWB 17, 2 ' Select All
- .ExecWB 12, 2 ' Copy selection
- Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
- With Sh
- .UsedRange.Offset(4).Clear
- .Range("B5").Select
- .PasteSpecial Format:="HTML"
- .Range("B5").Select
- If .Shapes.Count > 0 Then '有圖片
- .Shapes.SelectAll
- Selection.Delete
- End If
- End With
- End If
- Next
- .Quit '關閉 IE
- End With
- End Sub
複製代碼 |
|