在Excel中显示弹出窗口一段时间

Question

我正在尝试生成一个弹出窗口，并在给定的WaitTime秒后关闭。

我参考了这个链接和这个链接。

我尝试应用“VBA Excel宏消息框自动关闭”中的方法; 我的代码如下：

Sub TestSubroutine()

Dim TemporalBox As Integer
Dim WaitTime As Integer
Dim WScriptShell As Object

Set WScriptShell = CreateObject("WScript.Shell")

WaitTime = 1
TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")

End Sub

弹出窗口已经显示，但是它在一秒钟后没有关闭。

---

编辑 #1

根据@Skip Intro的评论，我已经更新了代码：

Sub TestSubroutine()

Dim WaitTime As Integer

WaitTime = 1
CreateObject("WScript.Shell").Popup "The message box will close in 1 second.", _
WaitTime, "File processed"

End Sub

然而，这并没有解决最初的问题，弹出窗口在1秒后仍未关闭。

编辑 #2

这是@Glitch_Doctor建议的代码，然而它仍然无法工作：

Sub TestSubroutine()

Dim TemporalBox As Integer
Dim WaitTime As Integer
Dim WScriptShell As Object
Dim test

Set WScriptShell = CreateObject("WScript.Shell")

WaitTime = 1
Select Case TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
    Case 1, -1
End Select

End Sub

- Daneel Olivaw

---

你可以在一行中调用弹出窗口：CreateObject("WScript.Shell").popup "This is a message", 1, "This is a header", 0 + 64 '。只有当你想要捕获响应时，它才会变得复杂，如果 Wait = 1 秒，我认为你不需要这样做。 - Skip Intro

谢谢你的建议。然而，这并没有解决原始问题，弹出窗口仍然保持打开状态。我已经更新了原始帖子。 - Daneel Olivaw

那段代码对我来说有效。弹出框会出现，然后一秒钟后自动关闭。 - Skip Intro

你用的是什么操作系统？我正在使用Windows 7，它按照预期工作。 - Robert J.

Windows 7 also. - Daneel Olivaw

嗯，你的代码，Edit#1和Edit#2的代码全部对我都有效 - Windows 7 Excel 2010 - Skip Intro

Answer 1

我终于找到了一个非常简单的解决方案-感谢@Orphid，可以在以下线程中查看他的答案：thread。

我没有解决与我的原始代码相关的具体问题，但我成功地创建了一个在指定时间后关闭的PopUp。 代码如下：

Sub subClosingPopUp(PauseTime As Integer, Message As String, Title As String)

Dim WScriptShell As Object
Dim ConfigString As String

Set WScriptShell = CreateObject("WScript.Shell")
ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & _
               "Popup(""" & Message & """," & PauseTime & ",""" & Title & """))"

WScriptShell.Run ConfigString

End Sub

这个工作完全正常。

- Daneel Olivaw

---

我们能把这个做成一个是/否的消息框吗？如果在暂停时间后没有按下“是”，能自动按下“否”吗？ - Gangula

这样做的好处是在显示消息时不会停止代码执行。 - 6diegodiego9

Answer 2

如果您原先的方法无法工作，可以采用另一种方法。

创建一个名为frm_Popup的新用户窗体，添加一个名为lbl_Message的标签。在用户窗体代码中添加以下void：

Public Sub StartProcess(iTime As Integer)
    Me.lbl_Message.Caption = "The message box will close in " & iTime & " second(s)."
End Sub

然后在你的模块中：

Sub ShowMessage()
    Dim iTimeToWait As Integer
        iTimeToWait = 2

    With frm_Popup
        .Show False
        Call .StartProcess(iTimeToWait)
    End With

    Application.OnTime Now + TimeValue("00:00:" & iTimeToWait), "HidePopup"
End Sub

Private Sub HidePopup()
    Unload frm_Popup
End Sub

- Robert J.

---

我本来打算在完成我正在努力工作的报告后，采用Application.OnTime的方式进行操作...干得漂亮，先生。 - Glitch_Doctor

Answer 3

你只是忘了 Select Case：

WaitTime = 1
Select Case TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
    Case 1, -1
End Select

我测试过了，它可以正常工作...

- Glitch_Doctor

---

当我尝试运行那段代码时，出现了一个运行时错误424：需要对象。 - Skip Intro

抱歉，我使用了你的原始代码，它与那些Dim一起工作。 - Glitch_Doctor

奇怪，你还是在使用Dim的时候出现错误吗？还是.Popup没有关闭？ - Glitch_Doctor

我没有任何错误，弹出窗口显示了但从未关闭。 - Daneel Olivaw

我能想到的另一件事是，我可能打开了一个你没有的引用，但其他答案应该有效。除了与此完全无关的互联网控件之外，我只打开了以下内容：Visual Basic For Applications、Microsoft Excel 14.0 Object Library、OLE Automation、Microsoft Office 14.0 Object Library。可惜我无法区分它们，只是在需要的时候打开了它们。 - Glitch_Doctor

我已经打开了相同的引用 - 只是我使用的是15.0版本而不是14.0版本，但我已经在另一台安装了15.0版本的计算机上测试了代码，它可以正常工作。 - Daneel Olivaw

Answer 4

以下代码对我有用，我在弹出消息出现之前添加了2秒的延迟。4秒后它会自动消失。我从Dinesh Kumar Takyar先生那里学到的。他在弹出窗口出现之前添加了5秒的延迟。他的YouTube链接是https://www.youtube.com/watch?v=x1nmqVRrq-Q&list=PLwC8syx0i_6nHjAogOm9m4oGBq40YHkXV&index=4。 我认为关键问题是你需要一个延迟来使弹出窗口计时器工作。也许Excel应用程序需要运行一段时间才会出现弹出窗口。

---

Option Explicit

Const PopUpTime As Integer = 4

Sub ShellMessageBox()

Dim MsgBoxWithTimer As Integer

MsgBoxWithTimer=CreateObject("WScript.Shell").Popup("Put your message here", PopUpTime, _
"Notice!", 0)

End Sub

Sub startTimer()
Application.OnTime Now + TimeValue("00:00:02"), "ShellMessageBox"
End Sub

Private Sub Workbook_Open()

startTimer

End Sub

- Anthony

Answer 5

以下代码对我来说有效：

Sub TimeBasedPopUp()

Dim WaitTime As Integer

WaitTime = 1
Select Case CreateObject("WScript.Shell").Popup("The message box will close in 1 second.",_
WaitTime, "MS Excel")
Case 1, -1

结束选择

结束子程序

- Akshay Jadhav