返回列表 上一主題 發帖

[分享] VBA 語句集 200 句

ajagow

帖子
17 
主題
1 
精華
1 
積分
42 
點名
0  
作業系統
Win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2012-4-8 
最後登錄
2012-6-15 
1# 跳轉到 »
發表於 2012-4-15 21:07 | 顯示全部帖子
謝謝C C LAI無私地分享
就是要來讓麻辣家族變得更強
這樣的回覆好像有衝犯版規
請版大人原諒
今天是那個盤中 DDE 存檔與 VBA 的實際應用範例程式，真的很順手
茅塞頓開
益謝兒

TOP

ajagow

帖子
17 
主題
1 
精華
1 
積分
42 
點名
0  
作業系統
Win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2012-4-8 
最後登錄
2012-6-15 
2#
發表於 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 大大的程式
感謝您們
益謝兒

TOP

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
返回列表 上一主題