返回列表 上一主題 發帖

[分享] 盤中 DDE 存檔與 VBA 的實際應用範例

[分享] 盤中 DDE 存檔與 VBA 的實際應用範例

貼上盤中 DDE 存檔與 VBA 的實際應用範例,供大家參考應用 (祈能普渡眾生)
這也是一般人在實務運用上常碰到的問題盲點,與其苦思困惑不知如何起筆
不如分享所知使人豁然頓悟。
希望大家以後都能成為高人,並祈指導指正!
盤中 DDE 存檔的實際應用範例.rar (1.11 KB)

我差點忘了與我擁有小學生等級的同學們是無法下載附件的,
所以我又將它直接貼了出來,方便大家閱覽。
  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
複製代碼

TOP

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

TOP

回復 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
複製代碼

TOP

回復 4# c_c_lai

撰寫程式,變數命名應該盡量避免VBA的保留字
3#所提的問題,在於你將變數名稱命名為index,這個保留字不被VBA系統所接受
因為此名稱,在VBA的語言中已被宣告成一個重要的指令,所以就類似重複宣告,而導致錯誤。
學海無涯_不恥下問

TOP

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

TOP

回復 5# Hsieh

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

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

謝謝
益謝兒

TOP

回復 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 的排程。 如此不斷循環作業,直到條件滿足為止。

TOP

無法執行該巨集

thisworkbookonstarter.JPG
2012-4-14 15:29
回復 8# c_c_lai
無法執行該巨集,不知問題出在哪裡。
我試過很多次,還是不能完成這麼好的程式。
請求幫忙
益謝兒

TOP

回復 9# ajagow
麻煩上傳檔案!

TOP

        靜思自在 : 閒人無樂趣,忙人無是非。
返回列表 上一主題