首页 /编程语言和算法/VB6/VBA/ASP
 VBA代码 MsgboxTimeOut
2025年3月18日 15:14
Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutW" ( _
            ByVal hWnd As Long, ByVal lpText As LongPtr, _
            ByVal lpCaption As LongPtr, ByVal wType As Long, _
            ByVal wLange As Long, ByVal dwTimeout As Long) As Long
#Else
    Private Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutW" ( _
            ByVal hWnd As Long, ByVal lpText As Long, _
            ByVal lpCaption As Long, ByVal wType As Long, _
            ByVal wLange As Long, ByVal dwTimeout As Long) As Long
#End If

Public Function MsgboxTimeOut(ByVal Prompt As String, Optional ByVal TimeOut As Long = -1&, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
        Optional ByVal Title As String = vbNullString, _
        Optional ByVal LangeId As Long = 0&) As VbMsgBoxResult
    'TimeOut以毫秒为单位,1 second = 1000 ms,TimeOut值为0时表示不自动返回,为负值时默认3秒
    '如果信息框弹出后,用户未点击任何按钮,将返回3200,但如果Buttons的按钮值为VbOkOnly时,返回VbOk
    If TimeOut < 0 Then TimeOut = 3000    '默认3秒
    If Len(Title) < 1 Then Title = "Excel Application"    '默认标题
    MsgboxTimeOut = MessageBoxTimeout(Application.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons Or &H2000&, LangeId, TimeOut)
End Function

Private Sub Test()
    Dim i, j, k, arr, brr, x, y

    MsgboxTimeOut "1", 1000
End Sub


 
全部回复(0)
首页 | 电脑版 |