Board logo

標題: [分享] 盤中 DDE 存檔與 VBA 的實際應用範例 [打印本頁]

作者: c_c_lai    時間: 2012-3-29 12:54     標題: 盤中 DDE 存檔與 VBA 的實際應用範例

貼上盤中 DDE 存檔與 VBA 的實際應用範例,供大家參考應用 (祈能普渡眾生)
這也是一般人在實務運用上常碰到的問題盲點,與其苦思困惑不知如何起筆
不如分享所知使人豁然頓悟。
希望大家以後都能成為高人,並祈指導指正!
[attach]10197[/attach]
作者: c_c_lai    時間: 2012-3-29 16:12

我差點忘了與我擁有小學生等級的同學們是無法下載附件的,
所以我又將它直接貼了出來,方便大家閱覽。
  1. ' 盤中 DDE 存檔的實際應用範例

  2. Option Explicit

  3. Dim actEnabled As Boolean
  4. Dim index As Single

  5. Private Sub Workbook_Open()
  6.     If (Sheets("工作表1").Range("AA1").Value = "") Then Sheets("工作表1").Range("AA1").Value = "08:45:00"   ' 假設AA1欄位為空白,則寫入開盤起始時間
  7.     If (Sheets("工作表1").Range("AA2").Value = "") Then Sheets("工作表1").Range("AA2").Value = "13:45:59"   ' AA2欄位亦同。(此兩欄紀錄起始終止時間)
  8.     If (Sheets("工作表1").Range("AA3").Value = "") Then Sheets("工作表1").Range("AA3").Value = 0            ' 紀錄最後資料匯入之列號 (Rows)。
  9.     If (Sheets("工作表1").Range("AA4").Value = "") Then Sheets("工作表1").Range("AA4").Value = "00:00:10"   ' 紀錄資料匯入相隔時間,如每隔十秒寫入一次。

  10.     If (TimeValue(Now) > Sheets("工作表1").Range("AA2").Value) Then       ' 如果目前時間業已超過AA2的時段,則呼叫.......
  11.         Call stopProcedure
  12.     Else                                                                  ' 反之,則呼叫.......
  13.         Call startProcedure
  14.     End If
  15. End Sub

  16. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  17.     On Error Resume Next
  18.     Call actStop
  19. End Sub


  20. Private Sub startProcedure()       ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  21.     Call actStart
  22. End Sub

  23. Private Sub stopProcedure()        ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  24.    Call actStop
  25. End Sub

  26. Sub Starter()
  27.     If (actEnabled = True And TimeValue(Now) >= Sheets("工作表1").Range("AA1").Value And TimeValue(Now) <= Sheets("工作表1").Range("AA2").Value) Then
  28.         index = Sheets("工作表1").Range("AA3").Value

  29.         If (Index = 0) Then Call newTitle  '假設newTitle程序(由使用者自行定義)是將第一列的資料抬頭名稱寫入到工作表2。 如:日期、時間、R1C5的對應欄位資料等。

  30.         Sheets("工作表1").Range("AA3").Value = index + 1       ' 紀錄列號加一。
  31.         Sheets("工作表2").Cells(index + 2, 1).Value = Date
  32.         Sheets("工作表2").Cells(index + 2, 2).Value = TimeValue(Now)
  33.         ' Sheets("工作表2").Cells(index + 2, 3).Value = Sheets("工作表1").Cells(1, 5).Value
  34.         '
  35.         ' 複製從券商DDE匯入之相對應位置資料,如 R1C5 對應的可能是收盤價等等。
  36.         '
  37.     End If
  38. End Sub


  39. Sub onStarter()
  40.     Call Starter
  41.     If actEnabled Then Call actStart
  42. End Sub

  43. Sub actStart()
  44.     actEnabled = True
  45.     Application.OnTime (Now + Sheets("工作表1").Range("AA4").Value), "ThisWorkBook.onStarter"   ' 寫入資料的排程 (目前是每隔十秒寫入一次)
  46. End Sub

  47. Sub actStop()
  48.     actEnabled = False

  49.     On Error Resume Next
  50.     Application.OnTime Now, "ThisWorkBook.onStarter", , False
  51. End Sub
複製代碼

作者: ajagow    時間: 2012-4-8 10:56

報告:套在2010 有問題
編輯錯誤,該成員已存在於此物件模組所繼承的模組中
Dim index As Single
==========
因為還是小學生,所以問題特別多
作者: c_c_lai    時間: 2012-4-8 19:10

回復 3# ajagow
這個模組旨在提供你如何在實務上撰寫一個屬於你個人的程式碼範例,
它的確是一組真的程式模組,你只是把對應的欄位加以修飾,再加上你個人的思考模式加以套入組合,
就成了你所需要的完整之程式碼了。
我再把它貼一次,程式碼請複製到 ThisWorkbook 內,直接編譯也無問題的。
  1. ' 盤中 DDE 存檔的實際應用範例

  2. Option Explicit

  3. Dim actEnabled As Boolean
  4. Dim index As Single

  5. Private Sub Workbook_Open()
  6.     If (Sheets("工作表1").Range("AA1").Value = "") Then Sheets("工作表1").Range("AA1").Value = "08:45:00"   ' 假設AA1欄位為空白,則寫入開盤起始時間
  7.     If (Sheets("工作表1").Range("AA2").Value = "") Then Sheets("工作表1").Range("AA2").Value = "13:45:59"   ' AA2欄位亦同。(此兩欄紀錄起始終止時間)
  8.     If (Sheets("工作表1").Range("AA3").Value = "") Then Sheets("工作表1").Range("AA3").Value = 0            ' 紀錄最後資料匯入之列號 (Rows)。
  9.     If (Sheets("工作表1").Range("AA4").Value = "") Then Sheets("工作表1").Range("AA4").Value = "00:00:10"   ' 紀錄資料匯入相隔時間,如每隔十秒寫入一次。

  10.     If (TimeValue(Now) > Sheets("工作表1").Range("AA2").Value) Then       ' 如果目前時間業已超過AA2的時段,則呼叫.......
  11.         Call stopProcedure
  12.     Else                                                                  ' 反之,則呼叫.......
  13.         Call startProcedure
  14.     End If
  15. End Sub

  16. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  17.     On Error Resume Next
  18.     Call actStop
  19. End Sub


  20. Sub startProcedure()       ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  21.     Call actStart
  22. End Sub

  23. Sub stopProcedure()        ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  24.    Call actStop
  25. End Sub

  26. Sub nnewTitle()
  27.    ' 套上你欲匯入資料的表頭名稱
  28. End Sub

  29. Sub Starter()
  30.     If (actEnabled = True And TimeValue(Now) >= Sheets("工作表1").Range("AA1").Value And TimeValue(Now) <= Sheets("工作表1").Range("AA2").Value) Then
  31.         index = Sheets("工作表1").Range("AA3").Value

  32.         If (index = 0) Then Call newTitle  '假設newTitle程序(由使用者自行定義)是將第一列的資料抬頭名稱寫入到工作表2。 如:日期、時間、R1C5的對應欄位資料等。

  33.         Sheets("工作表1").Range("AA3").Value = index + 1       ' 紀錄列號加一。
  34.         Sheets("工作表2").Cells(index + 2, 1).Value = Date
  35.         Sheets("工作表2").Cells(index + 2, 2).Value = TimeValue(Now)
  36.         ' Sheets("工作表2").Cells(index + 2, 3).Value = Sheets("工作表1").Cells(1, 5).Value
  37.         '
  38.         ' 複製從券商DDE匯入之相對應位置資料,如 R1C5 對應的可能是收盤價等等。
  39.         '
  40.     End If
  41. End Sub


  42. Sub onStarter()
  43.     Call Starter
  44.     If actEnabled Then Call actStart
  45. End Sub

  46. Sub actStart()
  47.     actEnabled = True
  48.     Application.OnTime (Now + Sheets("工作表1").Range("AA4").Value), "ThisWorkBook.onStarter"   ' 寫入資料的排程 (目前是每隔十秒寫入一次)
  49. End Sub

  50. Sub actStop()
  51.     actEnabled = False

  52.     On Error Resume Next
  53.     Application.OnTime Now, "ThisWorkBook.onStarter", , False
  54. End Sub
複製代碼

作者: Hsieh    時間: 2012-4-8 23:15

回復 4# c_c_lai

撰寫程式,變數命名應該盡量避免VBA的保留字
3#所提的問題,在於你將變數名稱命名為index,這個保留字不被VBA系統所接受
因為此名稱,在VBA的語言中已被宣告成一個重要的指令,所以就類似重複宣告,而導致錯誤。
作者: c_c_lai    時間: 2012-4-9 09:59

回復 5# Hsieh
謝謝您的指正!
今後我會特別去留意VBA的保留字, 我已將 index 更改成 cIndex (Check Index 之意,可依每個人編碼習慣自行去定義)
真不好意思留下了不好的錯誤示範。
作者: ajagow    時間: 2012-4-9 12:53

回復 5# Hsieh

謝謝 超級版主 及C_C LAI 解說
index   ==> CIndex
已將改正後執行
又有二個問題   Call newTitle  &  ThisWorkBook.onStarter
沒有定義    newTitle
                這是要在Sheet2 建立一個日期(A1)、時間(B1),收盤價(C1) ?
無法開啟  ThisWorkBook.onStarter

這個程式的用意是把盤中DDE的數字記錄成資料嗎
   

謝謝
作者: c_c_lai    時間: 2012-4-9 14:40

回復 7# ajagow
對不起!
在範例中 Sub newTitle()  (之前本想由使用者自行加上,但為增進你的瞭解,臨時加入的) 誤打成 Sub nnewTitle() 請你自行更正,
請留意 ThisWorkBook.onStarter,在 ThisWorkBook.onStarter中是有一點 "." 的 (ThisWorkBook + "." +  onStarter),
此意即是 "當設定時段到時即予執行 onStarter此程式段"

Sub onStarter()
    Call Starter
    If actEnabled Then Call actStart
End Sub

onStarter 程式段會去執行 Starter (此程式段負責將從DDE匯入之盤中資訊,實際寫入到你指定編寫的工作表單內),
執行完畢又會到 actStart 的排程。 如此不斷循環作業,直到條件滿足為止。
作者: ajagow    時間: 2012-4-14 15:32

[attach]10439[/attach][attach]10439[/attach]回復 8# c_c_lai
無法執行該巨集,不知問題出在哪裡。
我試過很多次,還是不能完成這麼好的程式。
請求幫忙
作者: c_c_lai    時間: 2012-4-14 16:36

回復 9# ajagow
麻煩上傳檔案!
作者: ajagow    時間: 2012-4-14 20:46

本帖最後由 ajagow 於 2012-4-14 20:51 編輯

[attach]10440[/attach][attach]10440[/attach][attach]10440[/attach]回復 10# c_c_lai
請幫忙,謝謝。
EXCEL 已經很難了,想不到VBA更難
作者: GBKEE    時間: 2012-4-14 21:30

本帖最後由 GBKEE 於 2012-4-15 06:39 編輯

回復 11# ajagow
你附檔的 ThisWorkBook. 物件模組 中並沒有 onStarter 這程式
當然程式會找不到   onStarter 程序是在 Module1 模組的中
改成  Application.OnTime (Now + Sheets("工作表2").Range("A4").Value), "onStarter"   
還有  Private Sub Workbook_Open() 如圖

[attach]10441[/attach]
作者: c_c_lai    時間: 2012-4-15 09:43

回復 11# ajagow
欄位的確認非常重要,你的語法我稍加修改了一下,大體上也都不錯,只是時間欄位的認定模糊而已,
我將修改之處用  ' ******** 加以標示出來,方便你瞭解無法執行的原因,下回你就會實際應用了。
附上已執行的範例,以及你的修改後之程式碼 (因你尚無法下載,所以將它貼示出來),你將程式碼複製到 ThisWorkbook 內,而將模組移除掉。
[attach]10443[/attach]
  1. ' 盤中 DDE 存檔的實際應用範例
  2. Option Explicit
  3. Dim actEnabled As Boolean
  4. Dim CIndex As Single

  5. Private Sub Workbook_Open()
  6.     If (Sheets("工作表1").Range("A1").Value = "") Then Sheets("工作表1").Range("A1").Value = "01:11:00"   ' 假設A1欄位為空白,則寫入開盤起始時間
  7.     If (Sheets("工作表1").Range("A2").Value = "") Then Sheets("工作表1").Range("A2").Value = "13:45:59"   ' A2欄位亦同。(此兩欄紀錄起始終止時間)
  8.     If (Sheets("工作表1").Range("A3").Value = "") Then Sheets("工作表1").Range("A3").Value = 0            ' 紀錄最後資料匯入之列號 (Rows)。
  9.     If (Sheets("工作表1").Range("A4").Value = "") Then Sheets("工作表1").Range("A4").Value = "00:00:10"   ' 紀錄資料匯入相隔時間,如每隔十秒寫入一次。

  10.     ' If (TimeValue(Now) > Sheets("工作表1").Range("A2").Value) Then     ' ********  你打算何時開始運作?13:45:59 以後?
  11.     If (TimeValue(Now) > Sheets("工作表1").Range("A1").Value) Then       ' 如果目前時間業已超過A2的時段,則呼叫.......
  12.         ' Call stopProcedure         ' ***** 時間到了,難道你不要執行?
  13.         Call startProcedure
  14.     Else                                                                  ' 反之,則呼叫.......
  15.         Call stopProcedure
  16.         ' Call startProcedure        ' ***** 請問你是要它在 14:00 ~ 01:09 間執行?
  17.     End If
  18. End Sub

  19. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  20.     On Error Resume Next
  21.     Call actStop
  22. End Sub

  23. Sub startProcedure()       ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  24.     Call actStart
  25. End Sub

  26. Sub stopProcedure()        ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  27.    Call actStop
  28. End Sub

  29. Sub newTitle()
  30.    ' 套上你欲匯入資料的表頭名稱
  31. End Sub

  32. Sub Starter()
  33.     If (actEnabled = True And TimeValue(Now) >= Sheets("工作表1").Range("A1").Value And TimeValue(Now) <= Sheets("工作表1").Range("A2").Value) Then
  34.         CIndex = Sheets("工作表1").Range("A3").Value

  35.         If (CIndex = 0) Then Call newTitle  '假設newTitle程序(由使用者自行定義)是將第一列的資料抬頭名稱寫入到工作表2。 如:日期、時間、R1C5的對應欄位資料等。

  36.         Sheets("工作表1").Range("A3").Value = CIndex + 1       ' 紀錄列號加一。
  37.         Sheets("工作表2").Cells(CIndex + 2, 1).Value = Date
  38.         Sheets("工作表2").Cells(CIndex + 2, 2).Value = TimeValue(Now)
  39.         ' Sheets("工作表2").Cells(CIndex + 2, 3).Value = Sheets("工作表1").Cells(1, 5).Value
  40.         Sheets("工作表2").Cells(CIndex + 2, 3).Value = Sheets("工作表1").Cells(6, 1).Value         ' 測試, 因今天不賣魚, 你的指定欄位有點..........

  41.         '

  42.         ' 複製從券商DDE匯入之相對應位置資料,如 R1C5 對應的可能是收盤價等等。

  43.         '
  44.         CIndex = Sheets("工作表1").Range("A3").Value      ' ********* 增加部分  (Counter 要加一,否則永遠為零)
  45.     End If
  46. End Sub

  47. Sub onStarter()
  48.     Call Starter
  49.     If actEnabled Then Call actStart
  50. End Sub

  51. Sub actStart()
  52.     actEnabled = True
  53.     ' Application.OnTime (Now + Sheets("工作表2").Range("A4").Value), "ThisWorkBook.onStarter"   ' ***** 工作表 2 的 A4 哪來個時間設定?
  54.     Application.OnTime (Now + Sheets("工作表1").Range("A4").Value), "ThisWorkBook.onStarter"     ' 寫入資料的排程 (目前是每隔十秒寫入一次)
  55. End Sub

  56. Sub actStop()
  57.     actEnabled = False

  58.     On Error Resume Next
  59.     Application.OnTime Now, "ThisWorkBook.onStarter", , False
  60. End Sub
複製代碼
[attach]10444[/attach]
作者: ajagow    時間: 2012-4-15 17:20

本帖最後由 ajagow 於 2012-4-15 17:24 編輯

回復 14# c_c_lai
感謝  版主的說明及c c lai 修改的程式
真的會自己跑
太神了
膜拜中
作者: et2002    時間: 2012-4-15 23:44

本帖最後由 et2002 於 2012-4-16 00:35 編輯

不好意思.小弟不太明白 EXCEL
如果我的 DDE 位置是 'MT4'|ASK!XAUUSD
那麼 應該加入到那?
問題已解決
作者: ajagow    時間: 2012-4-24 19:32

[attach]10640[/attach]回復 13# c_c_lai


    C  C  LAI   大大
我現在有一個問題?就是EXCEL 在跑的有時候會自動停,時間還是繼續流逝。有些資料沒有記錄到
那如果把想把時間切成五個小時來個別記錄不知道有沒有辦法
08:45:00~09:44:59
09:45:00~10:44:59
10:45:00~11:44:59
11:45:00~12:44:59
12:45:00~13:44:59
來抓取小時的成交價
這個很難,我去分兩段,只看到EXCEL的滑鼠一直畫圓圈.電腦就當著。
作者: c_c_lai    時間: 2012-4-24 20:13

回復 16# ajagow
請您留意看看,在您程式執行的階段是否同時會去執行別支 Excel 程式?
如果有的話,請勿操作別支 Excel,因為它們的執行序可能被干擾到了。
作者: ribbits    時間: 2012-9-9 11:07

回復 17# c_c_lai


    那請較一下,若同時取用不同訊號來源時,要如何規避您所說的錯誤風險呢?
作者: c_c_lai    時間: 2012-9-9 11:32

回復  c_c_lai


    那請較一下,若同時取用不同訊號來源時,要如何規避您所說的錯誤風險呢?
ribbits 發表於 2012-9-9 11:07

非 "不同訊號來源",我指的是盡可能不要在同一時段去
同時執行一支以上帶有VBA程式執行碼的 Excel 檔案。
附上圖片希望能幫助你了解:
[attach]12422[/attach]
你可以在一表單內同時匯入一支以上不同 DDE 訊號來源,這絕對是 OK 的,
但是如果你在同一時段同時執行一支以上類似如此之VBA
執行程式,VBA 程式極有可能會隨時莫名其妙地被中斷 (Interrupt)。
(我個人體驗,屢試不爽)    因此才會如此建議的。
作者: ribbits    時間: 2012-9-9 11:51

回復 23# c_c_lai


        所以在執行時段上若每15分記錄資料之EXCL VBA程式須集中在單一EXCEL內,而不同時段的VBA程式則不受影響了嗎?
比如國外期貨的時段就與國內不同,因此記錄的EXCEL VBA可個別開啟嗎?
因為時間差不同,只要取用當地時間來錯開就不會出錯了吧?
作者: ribbits    時間: 2012-9-9 11:56

因為個別管理關係,很多資料都必須獨立分隔來集中連續記錄的,所以同時執行好幾個獨立EXCEL的狀況可能無法避免。
除非把連續訊號導入類似ACCRESS或SQL等往後端資料庫集中管理,不過這些我之前問過好像沒人回答我:該如何作

因為我的VBA概念實在太爛了,所以空有架構卻無法執行:'
作者: c_c_lai    時間: 2012-9-9 21:12

回復 24# ribbits
端視你程式撰寫的技巧,是可以做到的!
作者: momowu    時間: 2012-10-22 10:13

請問一下,時間上的判斷是依據電腦上的時間,還是券商dde上的時間呢?
作者: c_c_lai    時間: 2012-10-22 11:55

請問一下,時間上的判斷是依據電腦上的時間,還是券商dde上的時間呢?
momowu 發表於 2012-10-22 10:13

1.  Excel 上 DDE 匯入之資料是以券商匯出當時時間之資料為準。
2. 至於電腦上的時間是否與券商 DDE 上的時間一致,你說呢?
    因為這涉及到訊號傳輸上的頻率問題,只能說憑直覺反應是這段時間的資訊而已。
    在交易處理上,依然是依據券商交易當時的時間為基準。
    接收端僅能當它做為參考而已。
作者: momowu    時間: 2012-10-22 12:07

謝謝C大釋疑
因為好奇一般程式的語法是判斷電腦的時間
還是券商DDE的時間
作者: honest632    時間: 2016-4-7 23:29

奇怪了,為什麼我的會顯示「陣列所索超出範圍」?
作者: c_c_lai    時間: 2016-4-8 09:22

回復 37# honest632
請附上你的 EXCEL 壓縮檔上傳,以便了解你問題的原因。
作者: honest632    時間: 2016-4-11 22:50

如附件,c大因為小弟對vba還一竅不通
麻請c大不吝賜教
作者: honest632    時間: 2016-4-13 22:31

C_C_LAI大你好:
上次傳的問題已經解決了,謝謝C大。
不過,想請教C大,不知可否也同時繪製成折線圖

感激不盡,謝謝~~
作者: c_c_lai    時間: 2016-5-4 17:13

回復 29# honest632
原則上是可行的,你再試試看,如仍有疑問,
請隨時提出來。
作者: frankchen7    時間: 2016-5-20 11:53

謝謝C_C_Lai大大的分享~~我還是初學者努力爬文中,剛剛用這個程式碼改成RTD資料下載方式來記錄,電腦的loading看來比較輕了
:D




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)