- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
15#
發表於 2012-8-26 11:43
| 只看該作者
本帖最後由 GBKEE 於 2012-8-26 11:49 編輯
回復 14# c_c_lai
ThisWorkbook 模組的程式碼- Public 紀錄_Msg As Boolean
- Private Sub Workbook_BeforeClose(Cancel As Boolean)
- 紀錄_Msg = True
- End Sub
- Private Sub Workbook_Open()
- Run "工作表1.紀錄" ' 程式一啟始,便去自動執行 工作表1.紀錄
- End Sub
- Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
- 'ThisWorkbook 的重算事件
- 'Sh 傳回是哪一個工作表有重算
- End Sub
複製代碼 工作表1模組的程式碼- '工作表1模組的程式碼(重算事件 )
- '工作表1 的A1 B1 C2 D1 E1 : 時間/開盤/價最高價/最低價/收盤價
- Private Sub Worksheet_Calculate()
- Static Msg As Boolean '用以判定是否為每日第一次執行
- Static Time_Calculate As Date '記錄每分鐘的時間
- Static AR '陣列:記錄成交價格
- If Time < #8:30:00 AM# Then Exit Sub
- Application.EnableEvents = False '停止物件能觸發事件(Worksheet_Calculate)
- If Msg = False Then
- Time_Calculate = TimeSerial(Hour(Time), Minute(Time), 0) '每分鐘的時間
- Range("A1").CurrentRegion.Offset(1) = "" '清理昨日資料
- ReDim AR(0) '重新設為一元素
- End If
- Msg = True
- If Time >= Time_Calculate + #12:01:00 AM# Then
- With Cells(Rows.Count, 1).End(xlUp).Offset(1)
- .Cells(1, 1) = Time_Calculate '時間
- .Cells(1, 2) = AR(0) '開盤價
- .Cells(1, 3) = Application.Max(AR) '最高價
- .Cells(1, 4) = Application.Min(AR) '最低價
- .Cells(1, 5) = AR(UBound(AR)) '收盤價
- End With
- Time_Calculate = TimeSerial(Hour(Time), Minute(Time), 0)
- ReDim AR(0)
- End If
- If AR(UBound(AR)) <> "" Then ReDim Preserve AR(UBound(AR) + 1) '重新再加上一元素
- AR(UBound(AR)) = [iv1] '記錄成交價格成交價
- Application.EnableEvents = True '恢復物件能觸發事件(Worksheet_Calculate)
- End Sub
- '樓主檔案是引用太平洋證券的DDE =好神通!D4 不必有此程序
- '紀錄程序:是測試Worksheet_Calculate的正確性
- Private Sub 紀錄()
- '紀錄時間執行迴圈 勿執行其他程式或輸入資料
- Dim t As Date, 價格(1 To 4) As Single
- 價格(1) = 100
- 價格(2) = Round(價格(1) + 價格(1) * 0.07, 2)
- 價格(3) = Round(價格(1) - 價格(1) * 0.07, 2)
- t = Time
- Do
- DoEvents
- If Time > t + #12:00:05 AM# Then
- t = Time
- 價格(4) = Round((價格(2) - 價格(3) + 1) * Rnd() + 價格(3), 2) '成交價的亂數
- If 價格(4) > 價格(2) Then 價格(4) = 價格(2)
- If 價格(4) < 價格(3) Then 價格(4) = 價格(3)
- [iv1] = "=" & 價格(4) '儲存格公式
- '**** 要觸動Worksheet_Calculate: 儲存格公式之值有變動 ****
- Debug.Print [iv1]
- End If
- Loop While ThisWorkbook.紀錄_Msg = True Or Time <= #1:30:00 PM#
- '關閉檔檔案 或 1:30:00 PM 停止紀錄
- End Sub
複製代碼 |
|