Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.11.2018, 11:23   #1
Олег Старченко
Новичок
Джуниор
 
Регистрация: 10.11.2018
Сообщений: 2
По умолчанию msgbox самостоятельное отключение через 5 секунд?

Подскажите, пожалуйста, можно ли сделать чтобы MSGBOX-окно самостоятельно отключалось , допустим, через 5 сек.?
Олег Старченко вне форума Ответить с цитированием
Старый 12.11.2018, 11:44   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

(с) Казанский

MsgBoxEx с таймаутом.

Код:
Option Explicit
 
Public Function MsgBoxEx(Prompt, Optional Buttons As VbMsgBoxStyle = 0, Optional Title, Optional SecondsToWait = 0) As VbMsgBoxResult
'---------------------------------------------------------------------------------------
' Procedure : MsgBoxEx
' Author    : Казанский, exceleved@yandex.ru
' Date      : 07.03.2014
' Purpose   : MsgBox with timeout based on WScript.Shell Popup method. Creates .VBS file
'             in temporary folder, runs it, returns result code, deletes the file.
' Arguments : First three are the same as for MsgBox, 4-th is timeout in seconds.
'           : If 4-th arg. is omitted or <=0 then waits for user action infinitely.
' Ret.Value : The same as of Msgbox, -1 if timeout occured.
' Errors    : Raises error 735 if temporary folder can't be found.
'---------------------------------------------------------------------------------------
 
Dim sTmp$, ff%, WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
sTmp = Environ("temp")
If sTmp = "" Then
  sTmp = Environ("tmp")
  If sTmp = "" Then
    sTmp = WshShell.SpecialFolders("MyDocuments")
    If sTmp = "" Then Err.Raise 735 'Can't save file to TEMP directory
  End If
End If
sTmp = sTmp & Format$(Now, """\~MsgBoxEx""YYMMDDHHMMSS"".vbs""")
ff = FreeFile
Open sTmp For Output As ff
 
If IsMissing(Title) Then Title = ""
 
'Popup(<Text>,<SecondsToWait>,<Title>,<Type>)
 
Print #ff, "WScript.Quit CreateObject(""WScript.Shell"").Popup (""" & Str2Code(Prompt) & _
  """, " & Int(SecondsToWait) & ", """ & Str2Code(Title) & """, " & Int(Buttons) & ")"
Close ff
MsgBoxEx = WshShell.Run(sTmp, 0, True)
On Error Resume Next
Kill sTmp
End Function
 
Private Function Str2Code$(s)
'---------------------------------------------------------------------------------------
' Procedure : Str2Code
' Author    : Казанский, exceleved@yandex.ru
' Date      : 07.03.2014
' Purpose   : Replaces combinations CR+LF, LF+CR, single chars CR, LF with " & vblf & "
'             to be used in VBS code
'---------------------------------------------------------------------------------------
 
Str2Code = Replace$( _
            Replace$( _
              Replace$( _
                Replace$( _
                  Replace$(s, """", """"""), _
                vbCrLf, vbLf), _
              vbLf & vbCr, vbLf), _
            vbCr, vbLf), _
           vbLf, """ & vblf & """)
End Function
Serge_Bliznykov вне форума Ответить с цитированием
Старый 12.11.2018, 12:53   #3
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

На самом деле, правильный способ - использовать WinAPI функцию MessageBoxTimeoutA
http://www.cyberforum.ru/vba/thread2146206.html
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 12.11.2018, 13:36   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Казанский Посмотреть сообщение
а самом деле, правильный способ - использовать WinAPI функцию MessageBoxTimeoutA
ну, так Вам же виднее!

позволю себе процитировать пример кода:
Код:
Private Declare Function MessageBoxTimeOut Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
Sub Msg()
    MessageBoxTimeOut Me.hWnd, "Пример Messagebox'а с таймаутом", "Автоматически закроется через 2 секунды", vbInformation + vbOKOnly, 0&, 2000
End Sub
кстати, у меня в Windows 7 64
код выдал ошибку на строке:
Цитата:
Код:
Private Declare Function MessageBoxTimeOut Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
error64.png

Последний раз редактировалось Serge_Bliznykov; 12.11.2018 в 13:40.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 12.11.2018, 13:51   #5
Олег Старченко
Новичок
Джуниор
 
Регистрация: 10.11.2018
Сообщений: 2
По умолчанию

Благодарю! Буду тестировать.
Олег Старченко вне форума Ответить с цитированием
Старый 12.11.2018, 14:27   #6
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
#If Win64 Then
  Private Declare PtrSafe Function MessageBoxTimeOut Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As LongLong
#Else
  Private Declare Function MessageBoxTimeOut Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
#End If
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 12.11.2018, 14:43   #7
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

IgorGO, спасибо. Работает!
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сбрасываются arp через 30 секунд Qaliti Общие вопросы по программированию, компьютерный форум 1 03.10.2018 22:19
Появление блока через 5 секунд после загрузки страницы Igorby HTML и CSS 2 06.09.2016 16:40
Выполнение скрипта через 5 секунд Arassir PHP 2 22.06.2011 21:40
Самостоятельное отключение ноутбука Леново G550 WEARWOLF Помощь студентам 1 17.12.2010 19:49
Закрыть через 5 секунд Михаил Юрьевич Общие вопросы Delphi 11 08.07.2008 10:43