- 帖子
- 17
- 主題
- 1
- 精華
- 1
- 積分
- 42
- 點名
- 0
- 作業系統
- Win 7
- 軟體版本
- office 2010
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2012-4-8
- 最後登錄
- 2012-6-15
|
4#
發表於 2012-4-25 20:28
| 只看該作者
本帖最後由 ajagow 於 2012-4-25 20:31 編輯
回復 11# chenua
' 盤中 DDE 存檔的實際應用範例
Option Explicit
Dim actEnabled As Boolean
Dim index As Single
Private Sub Workbook_Open()
If (Sheets("工作表1").Range("AA1").Value = "") Then Sheets("工作表1").Range("AA1").Value = "08:45:00" ' 假設AA1欄位為空白，則寫入開盤起始時間
If (Sheets("工作表1").Range("AA2").Value = "") Then Sheets("工作表1").Range("AA2").Value = "13:45:59" ' AA2欄位亦同。(此兩欄紀錄起始終止時間)
If (Sheets("工作表1").Range("AA3").Value = "") Then Sheets("工作表1").Range("AA3").Value = 0 ' 紀錄最後資料匯入之列號 (Rows)。
If (Sheets("工作表1").Range("AA4").Value = "") Then Sheets("工作表1").Range("AA4").Value = "00:00:10" ' 紀錄資料匯入相隔時間，如每隔十秒寫入一次。
If (TimeValue(Now) > Sheets("工作表1").Range("AA2").Value) Then ' 如果目前時間業已超過AA2的時段，則呼叫.......
Call stopProcedure
Else ' 反之，則呼叫.......
Call startProcedure
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Call actStop
End Sub
Private Sub startProcedure() ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
Call actStart
End Sub
Private Sub stopProcedure() ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
Call actStop
End Sub
Sub Starter()
If (actEnabled = True And TimeValue(Now) >= Sheets("工作表1").Range("AA1").Value And TimeValue(Now) <= Sheets("工作表1").Range("AA2").Value) Then
index = Sheets("工作表1").Range("AA3").Value
If (Index = 0) Then Call newTitle '假設newTitle程序(由使用者自行定義)是將第一列的資料抬頭名稱寫入到工作表2。 如：日期、時間、R1C5的對應欄位資料等。
Sheets("工作表1").Range("AA3").Value = index + 1 ' 紀錄列號加一。
Sheets("工作表2").Cells(index + 2, 1).Value = Date
Sheets("工作表2").Cells(index + 2, 2).Value = TimeValue(Now)
' Sheets("工作表2").Cells(index + 2, 3).Value = Sheets("工作表1").Cells(1, 5).Value
'
' 複製從券商DDE匯入之相對應位置資料，如 R1C5 對應的可能是收盤價等等。
'
End If
End Sub
Sub onStarter()
Call Starter
If actEnabled Then Call actStart
End Sub
Sub actStart()
actEnabled = True
Application.OnTime (Now + Sheets("工作表1").Range("AA4").Value), "ThisWorkBook.onStarter" ' 寫入資料的排程 (目前是每隔十秒寫入一次)
End Sub
Sub actStop()
actEnabled = False
On Error Resume Next
Application.OnTime Now, "ThisWorkBook.onStarter", , False
End Sub
這是 C C LAI 大大的程式
感謝您們 |
|
