CreateObject("Wscript.shell").Popup 自動關閉功能失效??
- 帖子
- 766
- 主題
- 256
- 精華
- 0
- 積分
- 1035
- 點名
- 0
- 作業系統
- windows 11
- 軟體版本
- OFFICE2021
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-5-30
- 最後登錄
- 2026-10-2
|
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分鐘繼續執行,如何做? |
|
|
|
|
|
|
|
- 帖子
- 766
- 主題
- 256
- 精華
- 0
- 積分
- 1035
- 點名
- 0
- 作業系統
- windows 11
- 軟體版本
- OFFICE2021
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-5-30
- 最後登錄
- 2026-10-2
|
2#
發表於 2013-7-20 09:31
| 只看該作者
本帖最後由 t8899 於 2013-7-20 09:36 編輯
我用
Application.Wait Now + TimeSerial(0, 3, 0)
會出現漏斗狀,無法做其他事情
這三分鐘裡,不要出現程式在跑(出現漏斗狀) |
|
|
|
|
|
|
|
- 帖子
- 766
- 主題
- 256
- 精華
- 0
- 積分
- 1035
- 點名
- 0
- 作業系統
- windows 11
- 軟體版本
- OFFICE2021
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-5-30
- 最後登錄
- 2026-10-2
|
3#
發表於 2013-7-20 13:12
| 只看該作者
如果用
Application.OnTime Now + TimeValue("00:03:00")
是否不會有出現漏斗的狀況??
不知如何改呢? |
|
|
|
|
|
|
|
- 帖子
- 766
- 主題
- 256
- 精華
- 0
- 積分
- 1035
- 點名
- 0
- 作業系統
- windows 11
- 軟體版本
- OFFICE2021
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-5-30
- 最後登錄
- 2026-10-2
|
4#
發表於 2013-7-20 13:50
| 只看該作者
我剛試了
停止三分鐘期間 IF 條件為何還是在跑?? |
|
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
5#
發表於 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
複製代碼 |
|
|
|
|
|
|
|
- 帖子
- 766
- 主題
- 256
- 精華
- 0
- 積分
- 1035
- 點名
- 0
- 作業系統
- windows 11
- 軟體版本
- OFFICE2021
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-5-30
- 最後登錄
- 2026-10-2
|
6#
倒序看帖
發表於 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) 測試一切正常
但選擇更新後,自動關閉功能不知為何會失效??? |
|
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
7#
發表於 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
複製代碼 |
|
|
|
|
|
|
|
- 帖子
- 766
- 主題
- 256
- 精華
- 0
- 積分
- 1035
- 點名
- 0
- 作業系統
- windows 11
- 軟體版本
- OFFICE2021
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-5-30
- 最後登錄
- 2026-10-2
|
8#
發表於 2013-7-22 12:05
| 只看該作者
回復 t8899
網路抓下的
GBKEE 發表於 2013-7-22 11:57 
我不會套用耶! |
|
|
|
|
|
|
|
- 帖子
- 766
- 主題
- 256
- 精華
- 0
- 積分
- 1035
- 點名
- 0
- 作業系統
- windows 11
- 軟體版本
- OFFICE2021
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2011-5-30
- 最後登錄
- 2026-10-2
|
9#
發表於 2013-7-22 15:42
| 只看該作者
直接這樣套用,明天再測試
Dim ws As Object
Set ws = CreateObject("wscript.shell") |
|
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
10#
發表於 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
複製代碼 |
|
|
|
|
|
|
|