VBA，如何使用类msgbox的效果，但是让窗口过几秒自动关闭？（未完成）msgbox函数的局限性：1 window Scripting Host（WSH）的Popup方法--实测2007可能不好用2 加载其他库的功能--好用3 加载其他库 Lib "user32"--好用这个为什么不好用？这个好用吗？自己写UI的方法

98 阅读 0 评论 65 点赞

我是靠谱客的博主糊涂招牌，最近开发中收集的这篇文章主要介绍VBA，如何使用类msgbox的效果，但是让窗口过几秒自动关闭？（未完成）msgbox函数的局限性：1 window Scripting Host（WSH）的Popup方法--实测2007可能不好用2 加载其他库的功能--好用3 加载其他库 Lib "user32"--好用这个为什么不好用？这个好用吗？自己写UI的方法，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

msgbox函数的局限性：

没有定时关闭的功能。
有字符数限制。
msgbox总是拥有焦点，只要对话框不关闭，代码就不会停止运行。

1 window Scripting Host（WSH）的Popup方法--实测2007可能不好用

这个算WINDOW的api吗？ CreateObject("wscript.shell").popUp
不知道为啥测试不好用，可能是EXCEL版本的问题
无论是直接使用，还是先赋值给变量都不行
另外这个方法也不能显示倒计时秒数，

Sub test_sample31()
CreateObject("wscript.shell").popUp "1秒钟关闭", 1, "提示", vbYes
End Sub


Sub test_sample32()
'Scripting Host（WSH）的Popup方法。
Dim w1 As Object
Set w1 = CreateObject("wscript.shell")
w1.popUp "3秒自动关闭", 3, "确定", vbOKOnly    'vbInformation
'Set w1 = Nothing

End Sub

2 加载其他库的功能--好用

2.1 加载lib "user32" Alias "messageBoxTimeOutA"

参考内容：http://club.excelhome.net/thread-590980-1-1.html
但是这个还不带倒计时，考虑下怎么加一个

Private Declare Function MessageBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long, ByVal wlange As Long, ByVal dwTimeout As Long) As Long

 Sub test1a()
    MessageBoxTimeout 0, "倒计5秒时关闭", "自动关闭", 0, 0, 5000
 End Sub

3 加载其他库 Lib "user32"--好用

写自定义过程
但是第一个过程不为什么不能被执行？
参考 http://www.excelpx.com/thread-267643-1-1.html

Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElaspe As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Dim TID As Long
Const Sec = 3  '可以在这里修改时间
Sub CloseTest(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
   Application.SendKeys "~", True '发送回符，即关闭窗口的命令
   KillTimer 0, TID
End Sub
Sub 三秒钟自动关闭()
  TID = SetTimer(0, 0, Sec * 1000, AddressOf CloseTest)
  MsgBox Sec & "  秒种自动关闭窗口", 65, "提示"
End Sub

同一个人写的

参考 http://www.excelpx.com/thread-298415-1-1.html

Option Explicit
Public MyModem As New MSCommLib.MSComm
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElaspe As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Dim TID As Long
Const Sec = 3  '可以在这里修改时间
Sub CloseTest(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
        Application.SendKeys "~", True '发送回符，即关闭窗口的命令
        KillTimer 0, TID
End Sub
Sub Dial_Number()
    Dim PhoneNum As String
    Dim PhoneNam As String
    Dim MsgboxRst
    PhoneNum = ActiveCell.Text
    PhoneNam = Cells(ActiveCell.Row, 3) + " at " + _
               Cells(1, ActiveCell.Column) + Chr(13) + PhoneNum
    'Remove shenzhen city code 0755
    If Left(PhoneNum, 4) = "0755" Then
        PhoneNum = Mid(PhoneNum, 8)
    End If
    'add prefix for Out_line
    If Len(PhoneNum) > 4 Then
        PhoneNum = "" + PhoneNum
    End If
    'Add prefix for Long-Distance call
    If Len(PhoneNum) > 4 And Mid(PhoneNum, 2, 1) = "0" Then
        PhoneNum = "911808" + PhoneNum
    End If
    'Replace right most "-" with ,,,, i.e. pause for extension
    PhoneNum = Replace(PhoneNum, "-", ",,,,,,")
    'activecell.Columns
    On Error GoTo ErrRpt
    MyModem.CommPort = 1
    If MyModem.PortOpen = False Then
        MyModem.PortOpen = True
    End If
    MyModem.OutPut = "ATDT" + PhoneNum + Chr(13)
    TID = SetTimer(0, 0, Sec * 1000, AddressOf CloseTest)
    MsgboxRst = MsgBox(PhoneNam, 0, "Calling...")
    MyModem.PortOpen = False
    Exit Sub
ErrRpt:
    TID = SetTimer(0, 0, Sec * 1000, AddressOf CloseTest)
    MsgBox "设置或连接不正确！", 65, "提示"
End Sub

这个为什么不好用？

这个不行，但是可以在msgbox出来后点击确定按纽后 几秒钟关闭。  
Sub sss()
Dim t, k
MsgBox "点击确定后5秒钟关闭文件“
t = Timer
k = i + 1
Do
Loop Until Timer - t = 5    ' 5秒
ActiveWorkbook.Save    ‘保存
ActiveWorkbook.Close  ' 关闭
End Sub

这名是关闭之前保存，03、07都没问题。
如果不用这句会跳出是否保存的对话框
如果以选择关闭之前不保存那可以用
Application.DisplayAlerts = False 替换 ActiveWorkbook.Save

修改一下，把wType定义成vbMsgBoxStyle，这样可以提示输入VBA里的MsgBox常数了。
Private Declare Function MsgBoxEx 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
Private Sub TestMsgboxEx()
    Dim ret As Long
    ret = MsgBoxEx(0, "请选择", "两秒后自动关闭", vbYesNo + vbInformation, 1, 2000)
    If ret = 32000 Then
        Debug.Print "超时关闭"
    ElseIf ret = vbYes Then
        Debug.Print "选择Yes"
    ElseIf ret = vbNo Then
        Debug.Print "选择No"
    End If
End Sub

这个为啥不好用？

http://www.excelpx.com/thread-298415-1-1.html

Option Explicit

Public Declare Function MsgBoxTimeOut Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long, ByVal wlange As Long, ByVal dwTimeout As Long) As Long

Sub PopupMsgbox(Optional prompt As String = "OK", Optional title As String = "友情提示", Optional seconds As Long = 300)
    MsgBoxTimeOut 0, prompt, title, 64, 0, seconds
End Sub

这个好用吗？

好了，很簡單吧！您執行程式時，當 MsgBox 出現 3 秒之後，就會自動關閉了！
注意：此方法的限制說明：

1、當常數設定為 VbAbortRetryIgnore 或 VbYesNo 時，無效！
2、在 Design Time 時，無效，必須 Make EXE 之後才有效！

参考 https://blog.csdn.net/smallboy_5/article/details/3009872

 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,   _   
  lParam   As   Any)   As   Long   
    
  Private   Const   WM_CLOSE   =   &H10   
  Private   Const   MsgTitle   As   String   =   "Test   Message"   
  '在表單中加入一個   CommandButton   及一個   Timer   控制項，加入以下程式碼：   
    
  Private   Sub   Command1_Click()   
        Dim   nRet   As   Long   
        Timer1.Interval   =   3000   
        Timer1.Enabled   =   True   
        nRet   =   MsgBox("若您不回應的話，3   秒後此   MsgBox   會自動關閉",   64,   MsgTitle)   
        Timer1.Enabled   =   False   
  End   Sub   
    
  Private   Sub   Timer1_Timer()   
        Dim   hWnd   As   Long   
        hWnd   =   FindWindow(vbNullString,   MsgTitle)   
        Call   SendMessage(hWnd,   WM_CLOSE,   0,   ByVal   0&)   
  End   Sub