您的位置: 首页  >  技术问答  >  从VBA中显示超时值的消息框的最佳方式是什么？

从VBA中显示超时值的消息框的最佳方式是什么？

分类: 技术问答 • 2022-09-15 08:30:34
问题描述：

这个问题是关于从下面列出的最好的解决方法，或者可能是另一个你知道的。从VBA中显示超时值的消息框的最佳方式是什么？

这是它来自这样的代码问题的背景...

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为此事一个消息。 问题是，在Excel 2007中（特别是在Internet Explorer中有时也会发生），弹出式窗口会意外地出现NOT超时，而不是等待用户输入。这个问题很难调试，因为它只是偶尔发生，我不知道重现问题的步骤。到目前为止，我认为这是Office模式对话框的一个问题，并且excel没有意识到超时已过期。
看到这里...... http://social.technet.microsoft.com/Forums/en-US/ITCG/thread/251143a6-e4ea-4359-b821-34877ddf91fb/

，我发现这里列出的方法可以解决该问题。
A.使用Win32 API调用

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.使用手动计时器的，被设计看起来像一个MessageBox一个VBA窗体。使用全局变量或类似的命令来保存任何需要传递回调用代码的状态。确保使用提供的vbModeless参数调用用户窗体的Show方法。

C.将对wscript.popup方法的调用包装在MSHTA进程中，这将允许代码用尽进程并避免办公的模式性质。

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

这个问题是关于从上面列出的最好的解决方法，或者可能是另一个你知道的。那么在VBA中显示超时值的消息框的最佳方式是什么？提名A，B或C或您自己的答案。

+1

不知道你的问题是什么...但Win32 API的解决方案看起来OK我。 – 2010-11-25 13:01:35

+0

对不起，如果我不够清楚。我认为这个问题的前两句是澄清的。我会重新编辑它。 – 2010-11-25 21:39:01

答

与答案一起答案的Win32解决方案。这符合要求，并且从目前的测试来看是稳健的。

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
+0

你可以使用通用的APC`SetTimer（）`调用，并在回调中弹出一个msgbox。 – Motes 2014-02-04 01:18:19

+0

小心使用一些替代代码编辑样本？ – 2014-02-21 02:18:59

答

这是一个漫长的答案，但有很多的地面覆盖：这也是一个迟到的答复，但由于一些答复到这一点（类似的问题）已张贴在堆栈上的东西已经改变。这在三相交流电中就像真空吸尘器一样吸引人，因为它们在发布时是很好的答案，并且有很多想法进入它们。

简短版本是：我注意到脚本WsShell Popup解决方案在一年前停止在VBA中工作，并且我为VBA MsgBox函数编写了一个可用的API定时器回调函数。

直接跳转到代码中的标题VBA代码在调用一个消息框，超时，如果你有急事需要一个答案 - 我做到了，我有数以千计自解聘的实例“ MsgPopup'替换VBA.MsgBox来编辑，下面的代码适合一个独立的模块。

但是，这里包括我自己在内的VBA编码器需要一些解释，为什么完美的代码似乎不再起作用。如果您了解原因，您可以使用部分解决方法来取消隐藏在文本中的“取消”对话框。


喝杯咖啡，这是一个长期的阅读...





我注意到脚本WsShell弹出液停在VBA为我工作的一年前 - 该“SecondsToWait”超时是被忽略，并且对话框只挂像周围熟悉的VBA.MsgBox：

MsgPopup = objWShell.PopUp(Prompt, SecondsToWait, Title, Buttons)

......我想我知道原因：您不能再从打开它的线程以外的任何位置向对话窗口发送WM_CLOSE或WM_QUIT消息。同样，User32 DestroyWindow（）函数不会关闭对话框窗口，除非它被打开对话框的线程调用。

Redmond中的某人不喜欢在后台运行脚本的想法，并向所有那些停止工作的重要警告发送WM_CLOSE命令（并且，这些日子让他们永远消失，需要本地管理员权限） 。我不能想象谁会写这样的脚本，这是一个可怕的主意！

该决定会导致后果和附带损害：单线程VBA环境中的WsScript.Popup（）对象使用Timer回调实现其'SecondsToWait'超时，并且该回调会发送WM_CLOSE消息或类似的东西...在大多数情况下被忽略，因为它是回调线程，不是对话框的所有者线程。

您可能让它在带有'CANCEL'按钮的弹出框上工作，它会变得清楚为什么在一两分钟内。

我试着给WM_CLOSE写一个定时器回调弹出窗口，在大多数情况下，我也失败了。

我已经尝试了一些异国情调的API回调与VBA.MsgBox和WsShell.Popup窗乱七八糟的，我现在可以告诉你，他们没有工作。你不能使用那些不存在的东西：这些对话框窗口非常简单，其中大部分都不包含任何功能，除了按钮点击中的响应外 - 是，否，确定，取消，中止，重试，忽略和帮助。

“取消”是一个有趣的：它出现在你指定vbOKCancel或vbRetryCancel或vbYesNoCancel是你从原始的Windows API的内置对话框和赠品 - “取消”功能与“关闭自动执行'对话框的菜单栏中的按钮（您不会用其他按钮来获得该按钮，但可以随意使用包含'忽略'的对话框尝试它），这意味着...。

WsShell.Popup（）对话框有时会如果他们有“取消”选项，则响应SecondsToWait超时。

objWShell.PopUp("Test Me", 10, "Dialog Test", vbQuestion + vbOkCancel)

这可能是一个足够好的解决办法的人读这篇文章，如果你想一切都让WsShell.Popup（）函数的参数SecondsToWait再次响应。

...这也意味着，你可以使用一个回调的SendMessage（）API调用发送WM_CLOSE消息，“取消”对话框：

SendMessage(hwndDlgBox, WM_CLOSE, ByVal 0&, ByVal 0&)

严格地说，这应该只为WM_SYSCOMMAND, SC_CLOSE信息工作 - “亲密'命令栏中的'box'是一个包含特殊命令类的'系统'菜单，但正如我所说的，我们从Windows API获得免费赠品。

我得到的工作，我开始思考：如果我只能在那里有什么工作，也许我会更好地发现什么是真正有 ...

......而答案圈出来是显而易见的：对话框都有自己的一套WM_COMMAND消息的参数 -

' Dialog window message parameters, replicating Enum vbMsgBoxResult: CONST dlgOK As Long = 1 CONST dlgCANCEL As Long = 2 CONST dlgABORT As Long = 3 CONST dlgRETRY As Long = 4 CONST dlgIGNORE As Long = 5 CONST dlgYES As Long = 6 CONST dlgNO As Long = 7

而且，因为这些都是用户响应返回给调用者（即，在“用户”的消息调用线程），对话框很乐意接受它们和c失去自我。

您可以询问一个对话窗口，看它是否实现了特定的命令，如果是的话，你可以发送命令：

If GetDlgItem(hWndMsgBox, vbRetry) <> 0 Then SendMessage hWndMsgBox, WM_COMMAND, vbRetry, 0& Exit For End If

剩下的挑战是检测“超时”和拦截返回的消息框响应，并替换我们自己的值：-1如果我们遵循由WsShell.Popup()函数建立的约定。所以我们用于带有超时的消息框的'msgPopup'包装需要做三件事：

  1. 调用我们的API定时器来延迟解除对话;
  2. 打开消息框，传入通常的参数;
  3. 或者：检测超时和替代“超时”响应...
    ......还是回到用户响应的对话框中，如果他们在 时间

其他方面回应，我们需要声明API调用了所有这些，并且我们绝对需要必须具有公共声明的TimerProc函数供Timer API调用。该函数必须存在，并且必须运行到'End Function'而没有错误或断点 - 任何中断，并且API Timer（）会调用操作系统的愤怒。

VBA代码来调用一个消息框超时：

 
Option Explicit 
Option Private Module
 
' Nigel Heffernan January 2016
 
' Modified from code published by Microsoft on MSDN, and on StackOverflow: this code is in
' the public domain.
 
' This module implements a message box with a 'timeout'
 
' It is similar to implementations of the WsShell.Popup() that use a VB.MessageBox interface 
' with an additional 'SecondsToWait' or 'Timeout' parameter.
 
Private m_strCaption As String
 
Public Function MsgPopup(Optional Prompt As String, _ 
         Optional Buttons As VbMsgBoxStyle = vbOKOnly, _ 
         Optional Title As String, _ 
         Optional SecondsToWait As Long = 0) As VbMsgBoxResult
 
' Replicates the VBA MsgBox() function, with an added parameter to automatically dismiss the message box after n seconds 
' If dismissed automatically, this will return -1: NOT 'cancel', nor the default button choice.
 
Dim TimerStart As Single
 
If Title = "" Then 
    Title = ThisWorkbook.Name 
End If
 
If SecondsToWait > 0 Then 
    ' TimedmessageBox launches a callback to close the MsgBox dialog 
    TimedMessageBox Title, SecondsToWait 
    TimerStart = VBA.Timer 
End If

 
MsgPopup = MsgBox(Prompt, Buttons, Title)

 
If SecondsToWait > 0 Then 
    ' Catch the timeout, substitute -1 as the response 
    If (VBA.Timer - TimerStart) >= SecondsToWait Then 
     MsgPopup = -1 
    End If 
End If
 
End Function
 


Public Function MsgBoxResultText(ByVal MsgBoxResult As VbMsgBoxResult) As String
' Returns a text value for the integers returned by VBA MsgBox() and WsShell.Popup() dialogs
 ' Additional value: 'TIMEOUT', returned when the MsgBoxResult = -1
' All other values return the string 'ERROR'

 On Error Resume Next

 If (MsgBoxResult >= vbOK) And (MsgBoxResult <= vbNo) Then MsgBoxResultText = Split("ERROR,OK,CANCEL,ABORT,RETRY,IGNORE,YES,NO,", ",")(MsgBoxResult) ElseIf MsgBoxResult = dlgTIMEOUT Then MsgBoxResultText = "TIMEOUT" Else MsgBoxResultText = "ERROR" End If
End Function ' ' ' ' ' ' ' ' ' ' Private Property Get MessageBox_Caption() As String MessageBox_Caption = m_strCaption End Property
 Private Property Let MessageBox_Caption(NewCaption As String) m_strCaption = NewCaption End Property

 Private Sub TimedMessageBox(Caption As String, Seconds As Long) On Error Resume Next
 ' REQUIRED for Function msgPopup ' Public Sub TimerProcMessageBox MUST EXIST
 MessageBox_Caption = Caption
 SetTimer 0&, 0&, Seconds * 1000, AddressOf TimerProcMessageBox
 Debug.Print "start Timer " & Now
 End Sub
 


#If VBA7 And Win64 Then ' 64 bit Excel under 64-bit windows
 ' Use LongLong and LongPtr

 Public Sub TimerProcMessageBox(ByVal hwnd As LongPtr, _ ByVal wMsg As Long, _ ByVal idEvent As LongPtr, _ ByVal dwTime As LongLong) On Error Resume Next
 ' REQUIRED for Function msgPopup ' https://msdn.microsoft.com/en-US/library/windows/desktop/ms644907(v=vs.85).aspx
 ' Closes a dialog box (Shell.Popup or VBA.MsgBox) having a caption stored in MessageBox_Caption ' This TimerProc sends any message that can close the dialog: the objective is solely to close ' the dialog and resume the VBA thread. Your caller must detect the expired TimerProc interval ' and insert a custom return value (or default) that signals the 'Timeout' for responses.
 ' The MsgPopup implementation in this project returns -1 for this 'Timeout'
 Dim hWndMsgBox As LongPtr ' Handle to VBA MsgBox
 KillTimer hWndMsgBox, idEvent
 hWndMsgBox = 0 hWndMsgBox = FindWindow("#32770", MessageBox_Caption)
 If hWndMsgBox <> 0 Then
 ' Enumerate WM_COMMAND values For iDlgCommand = vbOK To vbNo If GetDlgItem(hWndMsgBox, iDlgCommand) <> 0 Then SendMessage hWndMsgBox, WM_COMMAND, iDlgCommand, 0& Exit For End If Next iDlgCommand
 End If
 End Sub
 


#ElseIf VBA7 Then ' 64 bit Excel in all environments
 ' Use LongPtr only

 Public Sub TimerProcMessageBox(ByVal hwnd As LongPtr, _ ByVal wMsg As Long, _ ByVal idEvent As LongPtr, _ ByVal dwTime As Long) On Error Resume Next

 ' REQUIRED for Function msgPopup ' https://msdn.microsoft.com/en-US/library/windows/desktop/ms644907(v=vs.85).aspx
 ' Closes a dialog box (Shell.Popup or VBA.MsgBox) having a caption stored in MessageBox_Caption ' This TimerProc sends any message that can close the dialog: the objective is solely to close ' the dialog and resume the VBA thread. Your caller must detect the expired TimerProc interval ' and insert a custom return value (or default) that signals the 'Timeout' for responses.

 ' The MsgPopup implementation in this project returns -1 for this 'Timeout'
 Dim hWndMsgBox As LongPtr ' Handle to VBA MsgBox Dim iDlgCommand As VbMsgBoxResult ' Dialog command values: OK, CANCEL, YES, NO, etc
 KillTimer hwnd, idEvent
 hWndMsgBox = 0 hWndMsgBox = FindWindow("#32770", MessageBox_Caption)
 If hWndMsgBox <> 0 Then
 ' Enumerate WM_COMMAND values For iDlgCommand = vbOK To vbNo If GetDlgItem(hWndMsgBox, iDlgCommand) <> 0 Then SendMessage hWndMsgBox, WM_COMMAND, iDlgCommand, 0& Exit For End If Next iDlgCommand
 End If
 End Sub
 


#Else ' 32 bit Excel

 Public Sub TimerProcMessageBox(ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal idEvent As Long, _ ByVal dwTime As Long) On Error Resume Next
 ' REQUIRED for Function msgPopup
 ' The MsgPopup implementation in this project returns -1 for this 'Timeout'
 Dim hWndMsgBox As Long ' Handle to VBA MsgBox
 KillTimer hwnd, idEvent
 hWndMsgBox = 0 hWndMsgBox = FindWindow("#32770", MessageBox_Caption)
 If hWndMsgBox <> 0 Then
 ' Enumerate WM_COMMAND values For iDlgCommand = vbOK To vbNo If GetDlgItem(hWndMsgBox, iDlgCommand) <> 0 Then SendMessage hWndMsgBox, WM_COMMAND, iDlgCommand, 0& Exit For End If Next iDlgCommand
 End If
 End Sub
 #End If

而且这里的API声明 - 注意，VBA7，64位Windows有条件的声明，和纯香草32位：

' Explanation of compiler constants for 64-Bit VBA and API declarations : 
'  https://msdn.microsoft.com/en-us/library/office/ee691831(v=office.14).aspx
 


#If VBA7 And Win64 Then     ' 64 bit Excel under 64-bit windows ' Use LongLong and LongPtr 
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ 
                                    (ByVal lpClassName As String, _ 
                                     ByVal lpWindowName As String) As LongPtr 
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _ 
                                    (ByVal hwnd As LongPtr, _ 
                                     ByVal wMsg As Long, _ 
                                     ByVal wParam As Long, _ 
                                     ByRef lParam As Any _ 
                                     ) As LongPtr 
    Private Declare PtrSafe Function SetTimer Lib "user32" _ 
                                    (ByVal hwnd As LongPtr, _ 
                                     ByVal nIDEvent As LongPtr, _ 
                                     ByVal uElapse As Long, _ 
                                     ByVal lpTimerFunc As LongPtr _ 
                                     ) As Long 
     Public Declare PtrSafe Function KillTimer Lib "user32" _ 
                                    (ByVal hwnd As LongPtr, _ 
                                     ByVal nIDEvent As LongPtr _ 
                                     ) As Long 
    Private Declare PtrSafe Function GetDlgItem Lib "user32" _ 
                                    (ByVal hWndDlg As LongPtr, _ 
                                     ByVal nIDDlgItem As Long _ 
                                     ) As LongPtr 
     
#ElseIf VBA7 Then           ' VBA7 in all environments, including 32-Bit Office  ' Use LongPtr for ptrSafe declarations, LongLong is not available
 


    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ 
                                    (ByVal lpClassName As String, _ 
                                     ByVal lpWindowName As String) As LongPtr 
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _ 
                                    (ByVal hwnd As LongPtr, _ 
                                     ByVal wMsg As Long, _ 
                                     ByVal wParam As Long, _ 
                                     ByRef lParam As Any _ 
                                     ) As LongPtr 
    Private Declare PtrSafe Function SetTimer Lib "user32" _ 
                                    (ByVal hwnd As LongPtr, _ 
                                     ByVal nIDEvent As Long, _ 
                                     ByVal uElapse As Long, _ 
                                     ByVal lpTimerFunc As LongPtr) As LongPtr 
    Private Declare PtrSafe Function KillTimer Lib "user32" _ 
                                    (ByVal hwnd As LongPtr, _ 
                                     ByVal nIDEvent As Long) As Long 
    Private Declare PtrSafe Function GetDlgItem Lib "user32" _ 
                                    (ByVal hWndDlg As LongPtr, _ 
                                     ByVal nIDDlgItem As Long _ 
                                     ) As LongPtr 
#Else 
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 
                            (ByVal lpClassName As String, _ 
                             ByVal lpWindowName As String) As Long 
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ 
                            (ByVal hwnd As Long, _ 
                             ByVal wMsg As Long, _ 
                             ByVal wParam As Long, _ 
                             ByRef lParam As Any _ 
                             ) As Long 
    Private Declare Function SetTimer Lib "user32" _ 
                            (ByVal hwnd As Long, _ 
                             ByVal nIDEvent As Long, _ 
                             ByVal uElapse As Long, _ 
                             ByVal lpTimerFunc As Long) As Long 
    Public Declare Function KillTimer Lib "user32" _ 
                            (ByVal hwnd As Long, _ 
                             ByVal nIDEvent As Long) As Long 
    Private Declare Function GetDlgItem Lib "user32" _
                            (ByVal hWndDlg, ByVal nIDDlgItem As Long) As Long 
#End If
 


Private Enum WINDOW_MESSAGE 
    WM_ACTIVATE = 6 
    WM_SETFOCUS = 7 
    WM_KILLFOCUS = 8 
    WM_PAINT = &HF 
    WM_CLOSE = &H10 
    WM_QUIT = &H12 
    WM_COMMAND = &H111 
    WM_SYSCOMMAND = &H112 
End Enum
 


' Dialog Box Command IDs - replicates vbMsgBoxResult, with the addition of 'dlgTIMEOUT' 
Public Enum DIALOGBOX_COMMAND 
    dlgTIMEOUT = -1 
    dlgOK = 1 
    dlgCANCEL = 2 
    dlgABORT = 3 
    dlgRETRY = 4 
    dlgIGNORE = 5 
    dlgYES = 6 
    dlgNO = 7 
End Enum

最后请注意：我将欢迎有经验的MFC C++开发人员改进建议，一您将更好地掌握基于Windows对话框窗口的基本Windows消息传递概念 - 我的工作过于简单化了，而且我的理解过于简单化可能已经越过了我的错误说明。在此样本开始

答

发布我的最终代码如下：

' Coded by Clint Smith 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' tMsgBox Function (Timered Message Box) 
' By Clint Smith, [email protected] 
' Created 04-Sep-2014 
' This provides an publicly accessible procedure named 
' tMsgBox that when invoked instantiates a timered 
' message box. Many constants predefined for easy use. 
' There is also a global result variable tMsgBoxResult. 
' This was written using undocumented procedure in user32.dll 
' due to a buggy WScript.shell result where message window did 
' not close after timer expiration. 
' 
' Defaults to regular information top most message box with ok 
' button only. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Public Const mbBTN_Ok = vbOKOnly      'Default 
Public Const mbBTN_OkCancel = vbOKCancel 
Public Const mbBTN_AbortRetryIgnore = vbAbortRetryIgnore 
Public Const mbBTN_YesNoCancel = vbYesNoCancel 
Public Const mbBTN_YesNo = vbYesNo 
Public Const mbBTN_RetryCancel = vbRetryCancel 
Public Const mbBTN_CanceTryagainContinue = &H6 
Public Const mbICON_Stop = vbCritical 
Public Const mbICON_Question = vbQuestion 
Public Const mbICON_Exclaim = vbExclamation 
Public Const mbICON_Info = vbInformation 
Public Const mbBTN_2ndDefault = vbDefaultButton2 
Public Const mbBTN_3rdDefault = vbDefaultButton3 
Public Const mbBTN_4rdDefault = vbDefaultButton4 
Public Const mbBOX_Modal = vbSystemModal 
Public Const mbBTN_AddHelp = vbMsgBoxHelpButton 
Public Const mbTXT_RightJustified = vbMsgBoxRight 
Public Const mbWIN_Top = &H40000      'Default 

Public Const mbcTimeOut = 32000 
Public Const mbcOk = vbOK 
Public Const mbcCancel = vbCancel 
Public Const mbcAbort = vbAbort 
Public Const mbcRetry = vbRetry 
Public Const mbcIgnore = vbIgnore 
Public Const mbcYes = vbYes 
Public Const mbcNo = vbNo 
Public Const mbcTryagain = 10 
Public Const mbcContinue = 11 

Public Const wAccessWin = "OMain" 
Public Const wExcelWin = "XLMAIN" 
Public Const wWordWin = "OpusApp" 

Public tMsgBoxResult As Long 

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

Declare Function tMsgBoxA 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 

Public Sub tMsgBox(_ 
    Optional sMessage As String = "Default: (10 sec timeout)" & vbLf & "Coded by Clint Smith", _ 
    Optional sTitle As String = "Message Box with Timer", _ 
    Optional iTimer As Integer = 10, _ 
    Optional hNtype As Long = mbBTN_Ok + mbWIN_Top, _ 
    Optional hLangID As Long = &H0, _ 
    Optional wParentType As String = vbNullString, _ 
    Optional wParentName As String = vbNullString) 
    AppHWnd = FindWindow(wParentType, wParentName) 
    tMsgBoxResult = tMsgBoxA(AppHWnd, sMessage, sTitle, hNtype, hLangID, 1000 * iTimer) 
End Sub

答

易

Call CreateObject("WScript.Shell").Popup("Timed message box", 1, "Title", vbOKOnly)

相关推荐