麻辣家族討論版版 - Powered by Discuz! Board

標題: CreateObject("Wscript.shell").Popup 自動關閉功能失效?? [打印本頁]

作者: t8899 時間: 2013-7-20 09:01 標題: Worksheet_Calculate 裡想暫停三分鐘??

Private Sub Worksheet_Calculate()
If Not IsError(Range("q2")) Then
      If Range("Q2").Value > Range("R1").Value And Range("Q1").Value = 1 And flag = True Then
         CreateObject("Wscript.shell").Popup  Range("Q2").Value
         End If
   End sub
----------------------------------------------------
想在 CreateObject("Wscript.shell").Popup  Range("Q2").Value 之後
暫停3分鐘繼續執行,如何做?

作者: t8899 時間: 2013-7-20 09:31

本帖最後由 t8899 於 2013-7-20 09:36 編輯

我用
Application.Wait Now + TimeSerial(0, 3, 0)
會出現漏斗狀，無法做其他事情
這三分鐘裡，不要出現程式在跑(出現漏斗狀)

作者: t8899 時間: 2013-7-20 13:12

如果用
Application.OnTime Now + TimeValue("00:03:00")
是否不會有出現漏斗的狀況??
不知如何改呢?

作者: t8899 時間: 2013-7-20 13:50

我剛試了
停止三分鐘期間 IF 條件為何還是在跑??

作者: GBKEE 時間: 2013-7-20 14:44

本帖最後由 GBKEE 於 2013-7-20 16:14 編輯

回復 4# t8899
試試看

Private Sub Worksheet_Calculate()
Dim T As Date
If Not IsError(Range("q2")) Then
If Range("Q2").Value > Range("R1").Value And Range("Q1").Value = 1 And flag = True Then
CreateObject("Wscript.shell").Popup Range("Q2").Value
T = Time
Do While Time < T + #12:03:00 AM#
DoEvents
Loop
End If
End If
End Sub

複製代碼

作者: t8899 時間: 2013-7-22 09:48 標題: CreateObject("Wscript.shell").Popup 自動關閉功能失效??

Private Sub Worksheet_Calculate()

      If Not IsError(Range("Q5")) Then
         If (Range("Q5").Value < Range("Q6").Value) And Range("S8").Value = 2 And flag = True Then
      CreateObject("Wscript.shell").Popup "xxxxxxx=>正在殺  " & Range("Q5").Value, 3, "Auto Closed MsgBox", 64
      Cells(1, 13).Interior.ColorIndex = 2
      ' flag = False
      Range("Q6").Value = Range("Q6").Value - Range("R4").Value
      Range("R6").Value = Range("R6").Value - Range("R4").Value
      flag = True
      Cells(1, 13).Interior.ColorIndex = 8

      End If
End If

end sub

開檔選擇不更新(DDE) 測試一切正常
但選擇更新後，自動關閉功能不知為何會失效???

作者: GBKEE 時間: 2013-7-22 11:57

回復 6# t8899
網路抓下的

Sub MsgBox_Wait()
Dim WshShell, BtnCode
Set WshShell = CreateObject("WScript.Shell")
BtnCode = WshShell.popup("等待2秒不按我就自動關閉?", 2, "測試:", 4 + 16)
Select Case BtnCode
Case 6
BtnCode = "你按了""是""." 'MsgBox "你按了""是""."
Case 7
BtnCode = "你按了""否""." 'MsgBox "你按了""否""."
Case -1
BtnCode = "沒有按任何鍵"
End Select
BtnCode = WshShell.popup(BtnCode, 2, "測試完畢", 1)
End Sub

複製代碼

作者: t8899 時間: 2013-7-22 12:05

回復 t8899
網路抓下的
GBKEE 發表於 2013-7-22 11:57

我不會套用耶!

作者: t8899 時間: 2013-7-22 15:42

直接這樣套用，明天再測試
Dim ws As Object
Set ws = CreateObject("wscript.shell")

作者: GBKEE 時間: 2013-7-22 16:34

回復 8# t8899
我測試在作業系統有其他程式須處理,或交錯於Excel應用程式與其他應用程式之間 , WshShell.Popup 會不穩定(失去自動關閉功能)
以下程式碼試試看

Option Explicit
Private Sub Worksheet_Calculate()
If Not IsError(Range("Q5")) Then
If (Range("Q5").Value < Range("Q6").Value) And Range("S8").Value = 2 And flag = True Then
Wait_sub #12:00:30 AM# '程式暫停時間 '#12:01:00 AM# (一分鐘 ), #12:00:30 AM# (三十秒鐘 )
Cells(1, 13).Interior.ColorIndex = 2
' flag = False
Range("Q6").Value = Range("Q6").Value - Range("R4").Value
Range("R6").Value = Range("R6").Value - Range("R4").Value
flag = True
Cells(1, 13).Interior.ColorIndex = 8
End If
End If
End Sub
Private Sub Wait_sub(T As Date)
Dim tt As Date
'T = T + Time '程式碼在此會扣掉語音播放的時間
With CreateObject("SAPI.SpVoice") '創建語音物件
.volume = 100 '音量 0 - 100
.Rate = 0 '速度 0以上
.Speak "Please Wait" & T '語音播放
End With
T = T + Time '程式碼在此語音播放完畢,開始計時
tt = Time
Application.DisplayStatusBar = True '狀態列設定為可見
Do Until Time > T
DoEvents
If tt <> Time Then
tt = Time
Application.StatusBar = "還剩 " & Format(T - Time, "hh:mm:ss") '狀態列顯示剩餘時間
End If
Loop
Application.StatusBar = False '狀態列顯示為 [就緒]
End Sub

複製代碼

作者: t8899 時間: 2013-7-23 10:38

我把
Dim ws As Object
Set ws = CreateObject("wscript.shell")
套進去, 設定1秒關閉，但它為何在15-30 秒之間才會關閉 ??

-----------------------------------------------------
Private Sub Worksheet_Calculate()
Dim ws As Object
Set ws = CreateObject("wscript.shell")
   If Not IsError(Range("Q5")) Then
         If (Range("Q5").Value < Range("Q6").Value) And Range("S8").Value = 2 And flag = True Then
   ws.Popup "xxxxxxx=>正在殺  " & (Range("Q5").Value), 1, "Auto Closed MsgBox"
               Cells(1, 13).Interior.ColorIndex = 2
      ' flag = False
      Range("Q6").Value = Range("Q6").Value - Range("R4").Value
      Range("R6").Value = Range("R6").Value - Range("R4").Value
      flag = True
      Cells(1, 13).Interior.ColorIndex = 8

      End If
End If
end sub

作者: GBKEE 時間: 2013-7-23 11:02

回復 11# t8899
Winddows工作管理員有事在忙,CreateObject("wscript.shell")須等候排程處裡

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