显示带有超时值的消息框 [英] Display a message box with a timeout value

问题描述

问题来自于这样的代码.

The question comes from code like this.

Set scriptshell = CreateObject("wscript.shell")
    Const TIMEOUT_IN_SECS = 60
    Select Case scriptshell.popup("Yes or No? leaving this window for 1 min is the same as clicking Yes.", TIMEOUT_IN_SECS, "popup window", vbYesNo + vbQuestion)
        Case vbYes
            Call MethodFoo
        Case -1
            Call MethodFoo
    End Select

这是显示带有VBA(或VB6)超时信息的消息框的简单方法.

This is a simple way to display a message box with a timeout from VBA (or VB6).

在Excel 2007中(显然有时也会在Internet Explorer中发生)，弹出窗口不会超时，而是等待用户输入.

In Excel 2007 (apparently also happens in Internet Explorer at times) the popup window will not timeout, and instead wait for user input.

此问题很难调试，因为它仅偶尔发生，并且我不知道重现此问题的步骤.我认为这是Office模式对话框和Excel无法识别超时已过期的问题.

This issue is tough to debug as it only happens occasionally and I do not know the steps to reproduce the issue. I believe it to be an issue with Office modal dialogs and Excel not recognising the timeout has expired.

请参见> ://social.technet.microsoft.com/Forums/zh-CN/ITCG/thread/251143a6-e4ea-4359-b821-34877ddf91fb/

我找到的解决方法是:

A.使用Win32 API调用

A. Use a Win32 API call

Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Long, _
ByVal wLanguageID As Long, _
ByVal lngMilliseconds As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Public Sub MsgBoxDelay()
    Const cmsg As String = "Yes or No? leaving this window for 1 min is the same as clicking Yes."
    Const cTitle As String = "popup window"
    Dim retval As Long
    retval = MessageBoxTimeout(FindWindow(vbNullString, Title), cmsg, cTitle, 4, 0, 60000)

    If retval <> 7 Then
        Call MethodFoo
    End If

End Sub  

B.将手动计时器与VBA用户窗体一起使用，该窗体设计为类似于消息框.使用全局变量或类似变量保存需要传递回调用代码的所有状态.确保使用提供的vbModeless参数调用了用户窗体的Show方法.

B. Use a manual timer with a VBA userform that is designed to look like a messagebox. Use a global variable or similar to save any state that needs to be passed back to the calling code. Ensure that the Show method of the userform is called with the vbModeless parameter supplied.

C.在MSHTA流程中包装对wscript.popup方法的调用，这将使代码耗尽流程并避免Office的模式性.

C. Wrap the call to wscript.popup method in the MSHTA process which would allow the code to run out of process and avoid the modal nature of Office.

CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""Test"",2,""Real%20Time%20Status%20Message""))"

用A，B或C或您自己的答案在VBA中显示带有超时值的消息框的最佳方法是什么?

What is the best way of A, B or C or your own answer to display a message box with a timeout value in VBA?

推荐答案

与答案A. Win32解决方案一起使用.这样就可以满足要求，并且从目前的测试来看是可靠的.

Going with Answer A. the Win32 solution. This meets the requirements, and is robust from testing so far.

Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _ 
ByVal hwnd As Long, _ 
ByVal lpText As String, _ 
ByVal lpCaption As String, _ 
ByVal uType As Long, _ 
ByVal wLanguageID As Long, _ 
ByVal lngMilliseconds As Long) As Long 

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ 
ByVal lpClassName As String, _ 
ByVal lpWindowName As String) As Long 

Public Sub MsgBoxDelay() 
    Const cmsg As String = "Yes or No? leaving this window for 1 min is the same as clicking Yes." 
    Const cTitle As String = "popup window" 
    Dim retval As Long 
    retval = MessageBoxTimeout(FindWindow(vbNullString, Title), cmsg, cTitle, 4, 0, 60000) 

    If retval <> 7 Then 
        Call MethodFoo 
    End If 

End Sub

这篇关于显示带有超时值的消息框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！