现在的位置: 首页 > Office 杂记 > 正文

VBA 中定时关闭的 MsgBox——一个未公开的API

2014年06月11日 Office 杂记 ⁄ 共 1598字 ⁄ 字号 暂无评论 ⁄ 阅读 3,990 次

本文属网络资料整理而成

了解 VBA 的朋友们都知道,VBA 中自带的 MsgBox 不能自动关闭,需要用户做出交互后才能关闭。但是在某些特定情况下,我们需要 Msgbox 在指定时间内没有用户操作的情况下自动关闭,然后继续运行代码。一般采取的方法是使用Wscript.Shell 的 Popup 方法,或者自定义窗体, 或者采用 SetTimer 等来实现。这里推荐一个未公开的 API 函数—— MessageBoxTimeout 实现定时关闭消息框,感觉十分有用, 这里为了方便我们把它的名称声明为 MsgBoxTimeout,将 wType 声明为 VbMsgBoxStyle。

001

函数的声明如下(32位):
Private Declare Function MsgBoxTimeout
    Lib "user32" 
    Alias "MessageBoxTimeoutA" ( _
        ByVal hwnd As Long, _
        ByVal lpText As String, _
        ByVal lpCaption As String, _
        ByVal wType As VbMsgBoxStyle, _
        ByVal wlange As Long, _
        ByVal dwTimeout As LongAs Long
此函数的参数如下:
  • hwnd:消息框拥有者窗口的句柄,可以设为 0
  • lpText:消息框显示内容,类似于 MsgBox 函数的第一个参数 Prompt
  • lpCaption:消息框标题,类似于 MsgBox 函数的第三个参数 Caption
  • wType:消息框类型,类似于 MsgBox 函数的第二个参数 Buttons
  • wlange:函数扩展,一般取 0
  • dwTimeout:消息框延迟关闭时间,单位为毫秒
返回的值和 vbMsgBoxResult 常数一样,多了一个返回值 32000 表示超过延时时间未选择任何按钮。
具体例子见附件:

点击链接从百度网盘下载

示例代码如下:
'****************************************
'---此模块演示一个可以延时关闭的消息框---
'****************************************
#If Win64 Then '64位
    Private Declare PtrSafe Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As LongPtr, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#Else
    Private Declare Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As Long, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#End If
 
Sub btnMsgbox_Click()
    Dim xRet As Long
    xRet = MsgBoxTimeout(0, "此对话框如无交互操作将在 2 秒后自动关闭", "ExcelFans.com", vbYesNo + vbInformation, 1, 2000)
    Select Case xRet
    Case 32000
        Debug.Print "超时自动关闭"
    Case vbYes
        Debug.Print "选择""是""按钮"
    Case vbNo
        Debug.Print "选择""否""按钮"
    End Select
End Sub

 

给我留言

您必须 [ 登录 ] 才能发表留言!