返回列表 上一主題 發帖

[發問] 使用元大證Yeswin的RTD元件即時更新股價問題??

回復 1# jasonwu0114
自製看盤



ThisWorkbook 程式碼
  1. Option Explicit
  2. Dim ie()  As Object
  3. Const Sh = "看盤"  '指定工作表名稱
  4. Private Sub Workbook_Open()
  5.     Dim i As Integer, T As Date
  6.     Workbook_BeforeClose False
  7.     With Sheets(Sh)
  8.         Application.StatusBar = "網頁下載中..."
  9.         For i = 2 To .UsedRange.Columns(1).Rows.Count  '股票代號
  10.             ReDim Preserve ie(2 To i)
  11.             If .Cells(i, "A") <> "" And IsNumeric(.Cells(i, "A")) And Len(.Cells(i, "A")) >= 4 Then
  12.                 Set ie(i) = CreateObject("InternetExplorer.Application")
  13.                 ie(i).Navigate "http://newmis.twse.com.tw/stock/fibest.jsp?stock=" & .Cells(i, "A")
  14.                 DoEvents
  15.                 Application.StatusBar = "下載... " & .Cells(i, "A")
  16.                 ie(i).Visible = False
  17.             Else
  18.                 Set ie(i) = Nothing
  19.                 .UsedRange.Rows(i).Offset(, 1) = ""
  20.             End If
  21.         Next
  22.     End With
  23.     T = Time + #12:00:05 AM#
  24.     If Time < #9:00:00 AM# Then T = #9:00:00 AM#
  25.     Application.OnTime T, "ThisWorkbook.所有股價"
  26. End Sub
  27. Private Sub 即時股價(R As Integer)
  28.     Dim Element As Object, C As Integer
  29.     Application.EnableEvents = False
  30.     With Sheets(Sh)
  31.         If Not ie(R) Is Nothing Then
  32.             With ie(R)
  33.                 Do While .Busy Or .ReadyState <> 4: Loop
  34.                 Set Element = .document.getElementsByTagName("TABLE")(1) '
  35.             End With
  36.             For C = 0 To Element.Rows(1).Cells.Length - 1
  37.                 .Cells(R, C + 2) = Element.Rows(1).Cells(C).innertext
  38.             Next
  39.         Else
  40.             .UsedRange.Rows(R).Offset(, 1) = ""
  41.         End If
  42.     End With
  43.     Application.EnableEvents = True
  44. End Sub

  45. Private Sub 所有股價()
  46.     Dim R As Integer
  47.     If Time >= #1:30:00 PM# Then
  48.         Workbook_BeforeClose False
  49.         Application.StatusBar = "  已收盤!!!"
  50.         Exit Sub
  51.     End If
  52.     For R = 2 To UBound(ie)
  53.         即時股價 R
  54.     Next
  55.     Application.OnTime Time + #12:00:02 AM#, "ThisWorkbook.所有股價"
  56.     Application.StatusBar = Time & vbTab & "更新完成"
  57. End Sub
  58. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  59.     Dim e As Variant
  60.     On Error Resume Next
  61.     For Each e In ie
  62.        e.Quit
  63.        Set e = Nothing
  64.     Next
  65. End Sub
  66. Private Sub Workbook_SheetChange(ByVal Wsh As Object, ByVal Target As Range)
  67.     If Wsh.Name = Sh Then
  68.         If Target.Column = 1 And Target.Row > 1 Then Workbook_Open
  69.     End If
  70. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 難行能行,難捨能捨,難為能為,才能昇華自我的人格。
返回列表 上一主題