GBKEE

回復 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

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

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

GBKEE

回復 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

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

下載 (67.56 KB)

2015-3-29 14:38

Book3.zip (7.6 KB)

下載次數: 3

2015-3-29 14:37

GBKEE

回復 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

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

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