Application.OnTime 無法終止 ? - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » Application.OnTime 無法終止 ?

返回列表下一主題上一主題發帖

[發問] Application.OnTime 無法終止 ?

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

21^# 跳轉到 »

發表於 2015-3-29 11:40 | 只看該作者

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

回復 20# t8899
請在你VBA 專案中插入一表單
表單模組程式碼

Option Explicit
Private Sub UserForm_Activate()
Dim t As Date
Me.Hide
Ex_要執行的程式
t = Time
Do
If Msg Then Exit Do
DoEvents
If Time > t + #12:00:01 AM# Then
If Not Msg Then Ex_要執行的程式
t = Time
End If
Loop
End Sub
Private Sub userForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If Msg = False And Msg1 = False And CloseMode = 1 Then
Msg = True
Msg1 = True
MsgBox "程式結束"
Else
MsgBox "程式不在執行中"
End If
End Sub

複製代碼

一般模組程式碼

Option Explicit
Public Msg As Boolean, Msg1 As Boolean
Sub ex_Start()
Msg = False
UserForm1.Show (False)
End Sub
Sub Ex_End()
Unload UserForm1
End Sub
Sub Ex_要執行的程式()
Msg1 = False
With ActiveSheet.[a1]
.Value = .Value + 1
.Font.Size = IIf(.Font.Size = 12, 14, 12)
.Font.Bold = IIf(.Font.Size = 12, False, True)
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

大學生 Rank: 4

帖子: 759
主題: 249
精華: 0
積分: 1021
點名: 0
作業系統: windows 11
軟體版本: OFFICE2021
閱讀權限: 50
性別: 男
註冊時間: 2011-5-30
最後登錄: 2024-11-15

22^#

發表於 2015-3-29 13:16 | 只看該作者

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

抱歉，不是很懂，可否仍以18樓的例子，存成檔案，讓小弟測試?

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

23^#

發表於 2015-3-29 14:17 | 只看該作者

回復 22# t8899
試試看
一般模組的程式碼

Option Explicit
Dim runtime2 As Date, Rng As Range
Sub AUTO_OPEN()
Ex_OnTime
End Sub
Sub Ex_OnTime()
Set Rng = Sheets("Sheet1").[a1]
EX_a123
End Sub
Sub Ex_Stop_OnTime()
Application.OnTime runtime2, "EX_a123", , False
With Rng
.Value = ""
.Font.Size = 12
.Font.Bold = False
.Interior.ColorIndex = xlNo
End With
End Sub
Sub EX_a123()
With Rng
.Value = .Value + 1
.Font.Size = IIf(.Font.Size = 12, 14, 12)
.Font.Bold = IIf(.Font.Size = 12, False, True)
.Interior.Color = IIf(.Font.Size = 12, vbYellow, vbRed)
End With
runtime2 = Time + #12:00:01 AM#
Application.OnTime runtime2, "EX_a123"
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

大學生 Rank: 4

帖子: 759
主題: 249
精華: 0
積分: 1021
點名: 0
作業系統: windows 11
軟體版本: OFFICE2021
閱讀權限: 50
性別: 男
註冊時間: 2011-5-30
最後登錄: 2024-11-15

24^#

發表於 2015-3-29 14:38 | 只看該作者

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

Book3.zip (7.6 KB)

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

25^#

發表於 2015-3-29 15:05 | 只看該作者

回復 24# t8899
修改:

Sub Ex_Stop_OnTime()
If runtime2 < Time Then Exit Sub
Do
DoEvents
Loop Until runtime2 > Time
Application.OnTime runtime2, "EX_a123", , False
With Rng
.Value = ""
.Font.Size = 12
.Font.Bold = False
.Interior.ColorIndex = xlNo
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

大學生 Rank: 4

帖子: 759
主題: 249
精華: 0
積分: 1021
點名: 0
作業系統: windows 11
軟體版本: OFFICE2021
閱讀權限: 50
性別: 男
註冊時間: 2011-5-30
最後登錄: 2024-11-15

26^#

發表於 2015-3-29 15:14 | 只看該作者

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

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

靜思自在 : 手心向下是助人，手心向上是求人；助人快樂，求人痛苦。

返回列表下一主題上一主題