1234
返回列表 上一主題 發帖

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

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-3-29 12:54 | 只看該作者

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

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

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2012-3-29 16:12 | 只看該作者
我差點忘了與我擁有小學生等級的同學們是無法下載附件的，
所以我又將它直接貼了出來，方便大家閱覽。
  1. ' 盤中 DDE 存檔的實際應用範例

  3. Option Explicit

  5. Dim actEnabled As Boolean
  6. Dim index As Single

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

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

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


  27. Private Sub startProcedure()       ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
  28.     Call actStart
  29. End Sub

  31. Private Sub stopProcedure()        ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
  32.    Call actStop
  33. End Sub

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

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

  41.         Sheets("工作表1").Range("AA3").Value = index + 1       ' 紀錄列號加一。
  42.         Sheets("工作表2").Cells(index + 2, 1).Value = Date
  43.         Sheets("工作表2").Cells(index + 2, 2).Value = TimeValue(Now)
  44.         ' Sheets("工作表2").Cells(index + 2, 3).Value = Sheets("工作表1").Cells(1, 5).Value
  45.         '
  46.         ' 複製從券商DDE匯入之相對應位置資料，如 R1C5 對應的可能是收盤價等等。
  47.         '
  48.     End If
  49. End Sub


  52. Sub onStarter()
  53.     Call Starter
  54.     If actEnabled Then Call actStart
  55. End Sub

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

  62. Sub actStop()
  63.     actEnabled = False

  65.     On Error Resume Next
  66.     Application.OnTime Now, "ThisWorkBook.onStarter", , False
  67. End Sub
複製代碼

TOP

ajagow

帖子
17 
主題
1 
精華
1 
積分
42 
點名
0  
作業系統
Win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2012-4-8 
最後登錄
2012-6-15 
3#
發表於 2012-4-8 10:56 | 只看該作者
報告:套在2010 有問題
編輯錯誤，該成員已存在於此物件模組所繼承的模組中
Dim index As Single
==========
因為還是小學生，所以問題特別多

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
4#
發表於 2012-4-8 19:10 | 只看該作者
回復 3# ajagow
這個模組旨在提供你如何在實務上撰寫一個屬於你個人的程式碼範例，
它的確是一組真的程式模組，你只是把對應的欄位加以修飾，再加上你個人的思考模式加以套入組合，
就成了你所需要的完整之程式碼了。
我再把它貼一次，程式碼請複製到 ThisWorkbook 內，直接編譯也無問題的。
  1. ' 盤中 DDE 存檔的實際應用範例

  3. Option Explicit

  5. Dim actEnabled As Boolean
  6. Dim index As Single

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

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

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


  27. Sub startProcedure()       ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
  28.     Call actStart
  29. End Sub

  31. Sub stopProcedure()        ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
  32.    Call actStop
  33. End Sub

  35. Sub nnewTitle()
  36.    ' 套上你欲匯入資料的表頭名稱
  37. End Sub

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

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

  45.         Sheets("工作表1").Range("AA3").Value = index + 1       ' 紀錄列號加一。
  46.         Sheets("工作表2").Cells(index + 2, 1).Value = Date
  47.         Sheets("工作表2").Cells(index + 2, 2).Value = TimeValue(Now)
  48.         ' Sheets("工作表2").Cells(index + 2, 3).Value = Sheets("工作表1").Cells(1, 5).Value
  49.         '
  50.         ' 複製從券商DDE匯入之相對應位置資料，如 R1C5 對應的可能是收盤價等等。
  51.         '
  52.     End If
  53. End Sub


  56. Sub onStarter()
  57.     Call Starter
  58.     If actEnabled Then Call actStart
  59. End Sub

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

  66. Sub actStop()
  67.     actEnabled = False

  69.     On Error Resume Next
  70.     Application.OnTime Now, "ThisWorkBook.onStarter", , False
  71. End Sub
複製代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
86  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-4-10 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2012-4-8 23:15 | 只看該作者
回復 4# c_c_lai

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
6#
發表於 2012-4-9 09:59 | 只看該作者
回復 5# Hsieh
謝謝您的指正！
今後我會特別去留意VBA的保留字， 我已將 index 更改成 cIndex (Check Index 之意，可依每個人編碼習慣自行去定義)
真不好意思留下了不好的錯誤示範。

TOP

ajagow

帖子
17 
主題
1 
精華
1 
積分
42 
點名
0  
作業系統
Win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2012-4-8 
最後登錄
2012-6-15 
7#
發表於 2012-4-9 12:53 | 只看該作者
回復 5# Hsieh

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

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

謝謝
益謝兒

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
8#
發表於 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 的排程。 如此不斷循環作業，直到條件滿足為止。

TOP

ajagow

帖子
17 
主題
1 
精華
1 
積分
42 
點名
0  
作業系統
Win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2012-4-8 
最後登錄
2012-6-15 
9#
發表於 2012-4-14 15:32 | 只看該作者
回復 8# c_c_lai
無法執行該巨集，不知問題出在哪裡。
我試過很多次，還是不能完成這麼好的程式。
請求幫忙
益謝兒

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
10#
發表於 2012-4-14 16:36 | 只看該作者
回復 9# ajagow
麻煩上傳檔案！

TOP

        靜思自在 : 手心向下是助人，手心向上是求人；助人快樂，求人痛苦。
1234
返回列表 上一主題