Board logo

標題: [發問] Application.OnTime 無法終止 ? [打印本頁]
作者: t8899    時間: 2013-1-22 16:04     標題: 工作表每三分鐘自動執行某巨集

想在sheet1 每三分鐘就自動執行"123"巨集(Sub 123())一次,要如何寫??
作者: f3202    時間: 2013-1-22 17:58

回復 1# t8899


     Application.OnTime Now + TimeValue("00:03:00"), "123"
作者: t8899    時間: 2013-1-22 19:48

回復  t8899


     Application.OnTime Now + TimeValue("00:03:00"), "123"
f3202 發表於 2013-1-22 17:58


我在sheet1 用mouse 按右鍵"檢視程式碼" 將 Application.OnTime Now + TimeValue("00:03:00"), "123"  貼入 等三分沒反應??
前面要加什麼嗎??? (從alt-f8 確實有"123"的巨集)
作者: oobird    時間: 2013-1-22 20:43

在sheet1 用mouse 按右鍵"檢視程式碼" 將 Application.OnTime Now + TimeValue("00:03:00"), "123"  貼入
這樣是建立在sheet1所屬模組，應該要指定工作表：Application.OnTime Now + TimeValue("00:03:00"), "Sheet1.123"
不過程式名可以用數字嗎？
作者: t8899    時間: 2013-1-22 21:30

在sheet1 用mouse 按右鍵"檢視程式碼" 將 Application.OnTime Now + TimeValue("00:03:00"), "123"  貼入
...
oobird 發表於 2013-1-22 20:43


改成 "Sheet1.123" 三分後也沒反應?

另外測試
按右鍵"檢視程式碼"
加入以下
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call t
End Sub
Sub t()
Application.OnTime Now + TimeValue("00:01:00"), "123"
End Sub

請問這執行第一次正常 ,但第二次第三次......沒等1分鐘開始一直重覆執行"123" ???
作者: oobird    時間: 2013-1-22 21:37

给你個例子
[attach]14042[/attach]
作者: t8899    時間: 2013-1-22 21:44

给你個例子
oobird 發表於 2013-1-22 21:37


抱歉，小弟等級太低，無權下載附件
作者: t8899    時間: 2013-1-22 22:00

回復 7# t8899
可以麻煩寄到我的信箱嗎??
[email protected]
作者: f3202    時間: 2013-1-22 22:08

回復 8# t8899
例(放置在sheet1)
Sub a123()
Cells(1 + a, 1) = Time '您要做的動作
Application.OnTime Now + TimeValue("00:03:00"), "Sheet1.a123"
End Sub
作者: t8899    時間: 2013-1-22 23:56

回復  t8899
例(放置在sheet1)
Sub a123()
Cells(1 + a, 1) = Time '您要做的動作
Application.OnTime ...
f3202 發表於 2013-1-22 22:08

還是動不了
Cells(1 + a, 1) = Time ===>是什意思
作者: f3202    時間: 2013-1-23 07:49

回復 10# t8899

text版已寄到信箱
作者: c_c_lai    時間: 2013-1-23 09:04

回復 8# t8899
有以下之模式可供你選用：
(一)
  1. 置於模組 Module1 內：
  2. Private Sub Auto_Open()
  3.     Ex
  4. End Sub

  6. Sub Ex()
  7.     Static cts
  8.    
  9.     cts = cts + 1
  10.     Cells(cts, 1).Value = "Here I Am!"
  11.    
  12.     Application.OnTime (Now + TimeValue("00:03:00")), "Module1.Ex"
  13. End Sub
複製代碼
(二)
  1. 置於 ThisWorkbook 內：
  2. Private Sub Workbook_Open()
  3.     Ex
  4. End Sub

  6. Sub Ex()
  7.     Static cts
  8.    
  9.     cts = cts + 1
  10.     Cells(cts, 1).Value = "Here I Am!"
  11.    
  12.     Application.OnTime (Now + TimeValue("00:03:00")), "ThisWorkbook.Ex"
  13. End Sub
複製代碼
(三)
  1. 置於模組 Module1 內：
  2. Private Sub Auto_Open()
  3.     工作表1.Ex
  4. End Sub

  6. 置於 工作表1 內：
  7. Sub Ex()
  8.     Static cts
  9.    
  10.     cts = cts + 1
  11.     Cells(cts, 1).Value = "Here I Am!"
  12.    
  13.     Application.OnTime (Now + TimeValue("00:03:00")), "工作表1.Ex"
  14. End Sub
複製代碼
作者: 自我感覺良好    時間: 2013-1-26 09:40

[attach]14071[/attach]
Sub Macro1()
'
' Macro1 Macro
'
' 快速鍵: Ctrl+p
'
[a1] = [a1] + 1
Application.OnTime Now + TimeValue("00:00:05"), "Sheet1.a123"
End Sub


呀﹗請問要怎樣停止？
作者: 自我感覺良好    時間: 2013-1-26 19:12

原來是這樣子
http://office.microsoft.com/zh-tw/excel-help/HP005203075.aspx

停止巨集
全部顯示全部顯示

請執行下列其中一項動作：

    如果您要停止一個目前使用中的巨集，請按 ESC，然後按一下 [Microsoft Visual Basic] 對話方塊上的 [結束]。
    如果您想要避免在啟動 Microsoft Excel 時自動執行巨集，請在啟動時按住 SHIFT。
作者: e-bbm    時間: 2013-2-16 21:52

第1+a 的row 放入時間
作者: loquat    時間: 2013-2-19 12:05

没有权限下载附件，主要是自己水平太菜啊
作者: GBKEE    時間: 2013-2-19 16:47

還是動不了
Cells(1 + a, 1) = Time ===>是什意思
t8899 發表於 2013/1/22 23:56

查看VBA的說明可了解
作者: t8899    時間: 2015-3-29 08:33     標題: Application.OnTime 無法終止 ?

Sub amou()
Range("a1") = Range("a1") + 1
runtime2 = Now + TimeValue("00:00:10")
Application.OnTime runtime2, "amou"
End Sub

Sub a123()
On Error Resume Next
'Application.OnTime EarliestTime:=TimeValue(Runtime2), _
'   Procedure:="amou", Schedule:=False
' Application.OnTime EarliestTime:=Runtime2, _
  '   Procedure:="amou", Schedule:=False
  Application.OnTime runtime2, "amou", Schedule:=False
On Error GoTo 0
End Sub
作者: GBKEE    時間: 2015-3-29 10:01

本帖最後由 GBKEE 於 2015-3-29 10:04 編輯

回復 1# t8899
在這  Sub amou() 的模組頂端宣告 runtime2 為公用變數
如此 Sub a123() 才可得到runtime2 變數
  1. Public runtime2 As Date
  2. Sub amou()
  3. 'Dim runtime2 As Date 不要再宣告 runtime2 變數
  4. Range("a1") = Range("a1") + 1
  5. runtime2 = Now + TimeValue("00:00:10")
  6. Application.OnTime runtime2, "amou"
  7. End Sub
複製代碼
作者: t8899    時間: 2015-3-29 10:22

回復  t8899
在這  Sub amou() 的模組頂端宣告 runtime2 為公用變數
如此 Sub a123() 才可得到runtime2  ...
GBKEE 發表於 2015-3-29 10:01

謝謝!幾秒執行一次有無其他方法??
尤其像1秒1次(時鐘)，滑鼠指標會變成漏斗一閃一閃的狀態...
作者: GBKEE    時間: 2015-3-29 11:40

本帖最後由 GBKEE 於 2015-3-29 12:05 編輯

回復 20# t8899
請在你VBA 專案中插入一表單
表單模組程式碼
  1. Option Explicit
  2. Private Sub UserForm_Activate()
  3.     Dim t As Date
  4.     Me.Hide
  5.     Ex_要執行的程式
  6.     t = Time
  7.     Do
  8.         If Msg Then Exit Do
  9.         DoEvents
  10.         If Time > t + #12:00:01 AM# Then
  11.            If Not Msg Then Ex_要執行的程式
  12.             t = Time
  13.         End If
  14.     Loop
  15. End Sub
  16. Private Sub userForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  17.     If Msg = False And Msg1 = False And CloseMode = 1 Then
  18.         Msg = True
  19.         Msg1 = True
  20.         MsgBox "程式結束"
  21.     Else
  22.         MsgBox "程式不在執行中"
  23.     End If
  24. End Sub
複製代碼
一般模組程式碼
  1. Option Explicit
  2. Public Msg As Boolean, Msg1 As Boolean
  3. Sub ex_Start()
  4.     Msg = False
  5.     UserForm1.Show (False)
  6. End Sub
  7. Sub Ex_End()
  8.     Unload UserForm1
  9. End Sub
  10. Sub Ex_要執行的程式()
  11.     Msg1 = False
  12.     With ActiveSheet.[a1]
  13.         .Value = .Value + 1
  14.         .Font.Size = IIf(.Font.Size = 12, 14, 12)
  15.         .Font.Bold = IIf(.Font.Size = 12, False, True)
  16.     End With
  17. End Sub
複製代碼
作者: t8899    時間: 2015-3-29 13:16

回復  t8899
請在你VBA 專案中插入一表單
表單模組程式碼一般模組程式碼
GBKEE 發表於 2015-3-29 11:40

抱歉，不是很懂，可否仍以18樓的例子，存成檔案，讓小弟測試?
作者: GBKEE    時間: 2015-3-29 14:17

回復 22# t8899
試試看
一般模組的程式碼
  1. Option Explicit
  2. Dim runtime2 As Date, Rng As Range
  3. Sub AUTO_OPEN()
  4.     Ex_OnTime
  5. End Sub
  6. Sub Ex_OnTime()
  7.     Set Rng = Sheets("Sheet1").[a1]
  8.     EX_a123
  9. End Sub
  10. Sub Ex_Stop_OnTime()
  11.     Application.OnTime runtime2, "EX_a123", , False
  12.      With Rng
  13.         .Value = ""
  14.         .Font.Size = 12
  15.         .Font.Bold = False
  16.         .Interior.ColorIndex = xlNo
  17.     End With
  18. End Sub
  19. Sub EX_a123()
  20.     With Rng
  21.         .Value = .Value + 1
  22.         .Font.Size = IIf(.Font.Size = 12, 14, 12)
  23.         .Font.Bold = IIf(.Font.Size = 12, False, True)
  24.         .Interior.Color = IIf(.Font.Size = 12, vbYellow, vbRed)
  25.     End With
  26.     runtime2 = Time + #12:00:01 AM#
  27.     Application.OnTime runtime2, "EX_a123"
  28. End Sub
複製代碼
作者: t8899    時間: 2015-3-29 14:38

回復  t8899
試試看
一般模組的程式碼
GBKEE 發表於 2015-3-29 14:17

[attach]20541[/attach]
[attach]20540[/attach]
作者: GBKEE    時間: 2015-3-29 15:05

回復 24# t8899
修改:
  1. Sub Ex_Stop_OnTime()
  2.     If runtime2 < Time Then Exit Sub
  3.     Do
  4.         DoEvents
  5.     Loop Until runtime2 > Time
  6.     Application.OnTime runtime2, "EX_a123", , False
  7.      With Rng
  8.         .Value = ""
  9.         .Font.Size = 12
  10.         .Font.Bold = False
  11.         .Interior.ColorIndex = xlNo
  12.     End With
  13. End Sub
複製代碼
作者: t8899    時間: 2015-3-29 15:14

回復  t8899
修改:
GBKEE 發表於 2015-3-29 15:05


我剛又試出另一種停止方法
把全部的 time 改為 now 就可以了! (不知為什麼??)



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