CreateObject(&quot;Wscript.shell&quot;).Popup 自動關閉功能失效??

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

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

12^#

發表於 2013-7-23 11:02 | 只看該作者

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

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

t8899

大學生 Rank: 4

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

11^#

發表於 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

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

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

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

複製代碼

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

t8899

大學生 Rank: 4

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

9^#

發表於 2013-7-22 15:42 | 只看該作者

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

t8899

大學生 Rank: 4

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

8^#

發表於 2013-7-22 12:05 | 只看該作者

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

我不會套用耶!

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

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

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

複製代碼

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