Ver Mensaje Individual
  #5 (permalink)  
Antiguo 26/06/2009, 07:31
Avatar de David
David
Moderador
 
Fecha de Ingreso: abril-2005
Ubicación: In this planet
Mensajes: 15.720
Antigüedad: 19 años
Puntos: 839
Respuesta: Cerrar MsgBox Automaticamente

Aunque el hilo es viejo. Dejo una solución que puede servir a alguien:
Código vb:
Ver original
  1. Option Explicit
  2. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  3. Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  4. Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
  5. Private Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long
  6. 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
  7. Private Const WM_COMMAND = &H111
  8. Private msgTitle As String
  9. Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
  10. KillTimer hwnd, idEvent
  11. Dim hMessageBox As Long
  12. hMessageBox = FindWindow("#32770", msgTitle)
  13. If hMessageBox Then
  14.     SendMessage hMessageBox, WM_COMMAND, 6&, 0&
  15. End If
  16. End Sub
  17. Public Function MsgBoxEx(hwnd As Long, Prompt, Optional cSeconds As Long = 1, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title, Optional HelpFile, Optional Context) As VbMsgBoxResult
  18. Dim cMSeconds As Long
  19. cMSeconds = cSeconds * 1000
  20. Title = IIf(Title = "", App.Title, Title)
  21. msgTitle = Title
  22. SetTimer hwnd, 0&, cMSeconds&, AddressOf TimerProc
  23. MsgBoxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
  24. End Function
Para llamarlo:
Código vb:
Ver original
  1. MsgBoxEx Me.hwnd, "Se cierra en 5 segundos", 5, vbOKOnly + vbInformation, "Título"
__________________
Por favor, antes de preguntar, revisa la Guía para realizar preguntas.