t8899

Sub timestock()
Call  AAA ( True ) ' 放在  Application.OnTime The_Time, "timestock" 之前

my = #1 ...
bobomi 發表於 2014-10-17 20:11

Book1.rar (5.72 KB)

下載次數: 6

2014-10-17 20:54

applicaiton.ontime  麻煩真的很大
欲停止 ,執行階段錯誤1004
如何強迫停止???關掉excel ??

蝕光迴狼

回復 11# t8899


1. 是否可以說明這個程式的用意為何?
　如此才能真正幫你達到，你想要追求的效果。

2. 大部份時間有2種呈現方式【時間計時】與【倒數計時】。

3. 建議你可以設立2個按鈕【程式開始啟動】與【程式停止】會比較好。
　因為有關於時間，程式的寫法都是要即時更近的，就會發生你這種”程式停不下來”的窘境。

t8899

回復  t8899
1. 是否可以說明這個程式的用意為何?
　如此才能真正幫你達到，你想要追求的效果。
..
蝕光迴狼 發表於 2014-10-17 22:58

1. 是否可以說明這個程式的用意為何?
　如此才能真正幫你達到，你想要追求的效果。

1分鐘執行1次zzzzz程序
有時莫名其妙??秒，會執行1次,這種情形出現後，按停止鈕還在執行，只能關掉excel
Sub IE345678()
If Not Ie Is Nothing Then
MsgBoxTest 0, "IE345678 已執行", "提示訊息", vbSystemModal, 0, 2000
Exit Sub
End If
    Set Ie = CreateObject("InternetExplorer.Application")
    Ie.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
    Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop
    timestock
End Sub
-------------------------------------------------
Sub timestock()
   my = #12:01:00 AM#
The_Time = Time + my
Application.OnTime The_Time, "timestock"
    '-------------------------------------------------------
zzzzz ' 主要程序
'------------------------------------------------------------------------------------------
        If Not Ie Is Nothing Then
        Application.OnTime The_Time, "timestock", Schedule:=False
        Ie.Quit
        Set Ie = Nothing
                 End If
Exit Sub

3. 建議你可以設立2個按鈕【程式開始啟動】與【程式停止】會比較好。
　因為有關於時間，程式的寫法都是要即時更近的，就會發生你這種”程式停不下來”的窘境。

我本來就是做兩個按扭，但我也有把這兩個程序擺在 Private Sub Worksheet_Calculate()  裡
Private Sub Worksheet_Calculate()
  If TimeValue(Now) = TimeValue("13:24:51") Then
IE345678
End If

If TimeValue(Now) = TimeValue("13:30:30") Then
ASTOP
End If
end sub
---------------------------------------------------
Sub ASTOP()
        If Not Ie Is Nothing Then
        On Error Resume Next
           Ie.Quit
        Application.OnTime The_Time, "timestock", Schedule:=False
           MsgBoxTest 0, "已停止 ", "提示訊息", vbSystemModal, 0, 350
          End If
   
End Sub

GBKEE

回復 13# t8899
試試看

1. Option Explicit
   
2. Dim The_Time As Date '這模組的私用變數
   
3. Sub timestock()
   
4.     Dim my As Date
   
5.     If The_Time > Time Then
   
6.        Exit Sub
   
7.         '預防 上一次 OnTime尚未執行,再度執行一次OnTime
   
8.     End If
   
9.     Application.StatusBar = "執行 timestock  中..."
   
10.     my = #12:01:00 AM#
    
11.     The_Time = Time + my
    
12.     Application.OnTime The_Time, "timestock"
    
13.     Application.StatusBar = "下次執行 timestock  時間" & The_Time
    
14. End Sub
    
15. Sub ASTOP()
    
16.     If The_Time < Time Then
    
17.         MsgBox "沒有 OnTime 程序 ", , "提示訊息"
    
18.     Else
    
19.         Application.OnTime The_Time, "timestock", Schedule:=False
    
20.         MsgBox The_Time & " 的 OnTime 程序 已停止", , "提示訊息"
    
21.         Application.StatusBar = False
    
22.         The_Time = 0
    
23.     End If
    
24. End Sub

複製代碼

bobomi

Sub IE345678()

If Not Ie Is Nothing Then
   MsgBox "IE345678 已執行"
   Exit Sub
End If


    Set Ie = CreateObject("InternetExplorer.Application")
        Ie.Visible = 1
        Ie.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
        
    Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop
    timestock
End Sub

Sub timestock()

'Application.OnTime The_Time, "timestock"
    '-------------------------------------------------------
'zzzzz ' 主要程序
For w = 1 To 100000000
   
Next

'------------------------------------------------------------------------------------------
        If Not Ie Is Nothing Then
           Ie.Quit
           Set Ie = Nothing         
        End If
       my = 3 / 86400
       The_Time = Time + my
       Application.OnTime The_Time, "IE345678"
End Sub

bobomi

要求 99% 準時就這樣

Sub IE345678()

If Not IE Is Nothing Then
   Application.OnTime The_Time + 1 / 86400, "IE345678"
   Exit Sub
End If


    Set IE = CreateObject("InternetExplorer.Application")
        IE.Visible = 1
        IE.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
        
    Do While IE.Busy Or IE.ReadyState <> 4: DoEvents: Loop
    timestock
End Sub

Sub timestock()


        my = 3  / 86400
        The_Time = Time + my
        Application.OnTime The_Time, "IE345678"

    '-------------------------------------------------------
'zzzzz ' 主要程序
For w = 1 To 100000000
   
Next

'------------------------------------------------------------------------------------------
        If Not IE Is Nothing Then
           IE.Quit
           Set IE = Nothing
        End If
End Sub

t8899

Sub IE345678()

If Not Ie Is Nothing Then
   MsgBox "IE345678 已執行"
   Exit Sub
End If
  ...
bobomi 發表於 2014-10-18 08:23

要測試一段時間,希望能解決問題,謝謝指導 .

t8899

要求 99% 準時就這樣

Sub IE345678()

If Not IE Is Nothing Then
   Application.OnTime The_Time + ...
bobomi 發表於 2014-10-18 08:31

要測試一段時間,希望能解決問題,謝謝指導 .

t8899

回復  t8899
試試看
GBKEE 發表於 2014-10-18 07:10

my = #12:01:00 AM#
是不是這問題 ??上午跑沒問題，下午循還2-3次會跳出??

GBKEE

回復 19# t8899
   

my = #12:01:00 AM#
是不是這問題 ??上午跑沒問題，下午循還2-3次會跳出??

鐵定不是,要附檔看看或是完整程式碼

1. Sub Ex()
   
2.     Dim A As Double
   
3.     A = #12:01:00 AM#
   
4.     MsgBox A = 60 / 86400
   
5. End Sub

複製代碼