Вот решение, которое поддерживает возврат каретки, которое использует вызов API вместо WScript.Shell и работает в Excel VBA. Он поддерживает стандартные перечисляемые параметры, такие как vbQuestion + vbYesNo
, и может возвращать ответ пользователя. 32000
возвращается, если истекло время ожидания.
Это также имеет то преимущество, что вместо основного дисплея всплывающее окно отображается на том же мониторе, что и приложение.
' This part needs to be at the top of a VBA module
#If Win64 Then
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 TestMsgbox()
Dim ReturnValue
ReturnValue = MsgBoxTimeout(0, "Do you like this message?" & vbCrLf & "This message box will be closed after 4 seconds." & vbCrLf & vbCrLf & "(See Immediate window for return value)", "Return Choice", vbQuestion + vbYesNoCancel, 0, 4000)
Select Case ReturnValue
Case vbYes
Debug.Print "You picked Yes."
Case vbNo
Debug.Print "You picked No."
Case vbCancel
Debug.Print "You picked Cancel."
Case 32000
Debug.Print "Timeout before user made selection."
End Select
End Sub
Дополнительная информация:
https://www.extendoffice.com/documents/excel/3836-excel-message-box-timer-timeout.html