Visualizza temporaneamente un Msgbox

Hai un problema con Excel?

Nuova discussione

Visualizza temporaneamente un Msgbox
di DPG70 (utente non iscritto) data: 26/11/2014 18:38:14
Vorrei visualizzare temporaneamente cioè per alcuni secondi stabiliti un MsgBox, per poi sparire dallo schermo.
Ho trovato questa proprietà che sospende solamente temporaneamente il codice=
Application.Wait (Now + TimeValue("0:00:10")) 'sospensione dell'applicazione per tempo or ora indicata.
Vorrei scoprire la proprietà adatta o come inserire la stessa nel pulsante [X] del form di messaggio MsgBox.

Buona sera. Dario

Sub Filtri()
   
      MsgBox ("Stai attivando il filtro selezionato dal Cod. alla Commessa che segue:")
        Application.Wait (Now + TimeValue("0:00:05"))
   MsgBox ("Stai applicando il filtro selezionato dal Cod. alla " & _
         Chr(13) & "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" & Chr(13) & "   Commessa:" & Chr(13) & "[ " & (Range("G7").Value) & (" ]")), , ("Commessa")
    Range("F9:F3000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("D3:D4"), Unique:=False
    Range("A10").Select
End Sub

di lepat (utente non iscritto) data: 26/11/2014 18:47:27
non capisco, il msgbox attende che tu lo chiuda, a cosa ti serve il WAIT ?
di DPG70 (utente non iscritto) data: 26/11/2014 19:00:56
Ho solo cercato e trovato una proprietà che intuitivamente potesse darmi un risultato, ovviamente la proprietà sbagliata.
Vorrei far apparire a schermo per alcuni secondi, il MsgBox di testata del codice per poi procedere normalmente con la sua lettura.
di lepat (utente non iscritto) data: 26/11/2014 20:27:01
allora devi ricorrere ad una userform col messaggio, ne vale la pena ?
di lepat (utente non iscritto) data: 26/11/2014 20:34:44
vedi allegato
di DPG70 (utente non iscritto) data: 27/11/2014 20:37:14
Grazie lepat, come supponevi non vale la pena.
Speravo, e in modo semplice di poter comandare il pulsante a X sul form del msgbox.
Costruire una nuova struttura di form non è il caso, studierò l'allegato che mi potrà essere utile.
Ancora... Dario.

di DPG70 (utente non iscritto) data: 04/12/2014 21:37:41
Cercando ho trovato in rete una soluzione alla mia domanda.

Sub Filtri()

Dim obj As Object
Dim strMsg As String
Set obj = CreateObject("WScript.Shell")

If Range("F8").Value = "non trovato" Then
  'riproduco un segnale acustico di avviso
  Beep
    'Popup Message Box si chiuderà automaticamente da solo dopo 2 secondi
    strMsg = obj.popUp("Codice di iserimento in F8 non trovato !!!", 2, "Codice", vbOKCancel)
 Exit Sub

........ altro codice .......

End Sub

di lepat (utente non iscritto) data: 05/12/2014 08:51:23
molto interessante, ti dispiace allegare il link ? per evitare l'antispam scrivi h t t p ......
di Mister_x (utente non iscritto) data: 05/12/2014 15:37:48
ciao

visto la soluzione ma e' uguale a msgbox con la variante che e' uno WScript.Shell-obj.popUp
quindi se tu attivi unaltra cella questa va a depositarsi sulla shell di windows Barra dei comandi in fondo, e rimane sempre attiva
non vedo come fa a disattivarsi dopo 2 secondi????

come scritto da lepad rimango anch'io in attesa del link per capire il funzionamento in quanto se fa questo lavoro la cosa e' molto interessante

ciao

di isy data: 05/12/2014 17:43:28
Da valutare...
Allego un codice che tramite le API di windows disabilita il msgbox

'In un modulo:
'To display a timed Msgbox use the Msgbox2 routine given below. Note, a demonstration routine can be found at the bottom of this post:

'------------API calls for Msgbox2------------------------
'------------MUST BE PLACED IN A STANDARD MODULE----------
Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
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 Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long


'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub


'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub



'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function Msgbox2(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    Msgbox2 = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function

'Demonstration routine
Sub TestMessage()
    Dim lRetVal As VbMsgBoxResult
    lRetVal = Msgbox2("This message will be displayed for 2 seconds", vbOKCancel + vbInformation, "Test Message", 2000)
    Debug.Print lRetVal
End Sub

di DPG70 (utente non iscritto) data: 05/12/2014 20:37:48
Ciao a tutti...

Per lepat e Mister_x: non ritrovo al momento in rete il documento informativo in questione ma vi copio il codice di interesse che avevo salvato.

E per isy, cercherò di capire il suo lungo codice perchè a colpo d'occhio è per me fuori portata.

Public dTime As Date
Sub ricordami()
On Error Resume Next
dTime = Now + TimeValue("00:00:01")
Application.OnTime dTime, "ricordami"
'Chiudere la cartella di lavoro nel momento specificato

If Time = TimeSerial(18, 30, 0) Then
chiudiCAR
End If

'Impostare promemoria di chiusura ufficio
If Time = TimeSerial(17, 30, 0) Then
Application.OnTime dTime, "chiudiOF"
End If

'impostare promemoria pausa pranzo
If Time = TimeSerial(13, 0, 0) Then
Application.OnTime dTime, "pranzo"
End If

'impostare il promemoria per la pausa caffè 
If Time = TimeSerial(11, 15, 0) Then
Application.OnTime dTime, "Pcaffe"
End If
End Sub
------------------------------------------------------------------------------
Sub ricordamiST()
'fermare la procedura ricordami
Application.OnTime dTime, "ricordami", , False
End Sub

Sub chiudiCAR()
On Error Resume Next
ricordamiST
'salva cartella di lavoro prima della chiusura
ThisWorkbook.Save
'chiude la cartella di lavoro
ThisWorkbook.Close
End Sub

Sub Pcaffe()
Dim obj As Object
Dim strMsg As String
Set obj = CreateObject("WScript.Shell")
'riproduco un segnale acustico di avviso
Beep
'Popup Message Box si chiuderà automaticamente da solo
strMsg = obj.Popup("Pausa Caffè!", vbOKCancel)
End Sub

Sub pranzo()
Dim obj As Object
Dim strMsg As String
Set obj = CreateObject("WScript.Shell")
Beep
strMsg = obj.Popup("Pausa Pranzo!", vbOKCancel)
End Sub

Sub chiudiOF()
Dim obj As Object
Dim strMsg As String
Set obj = CreateObject("WScript.Shell")
Beep
strMsg = obj.Popup("Chiudi Ufficio!", vbOKCancel)
End Sub

di isy (utente non iscritto) data: 05/12/2014 21:13:31
Ciao DPG70

Nota: Non ti sto consigliando di utilizzare il codice con le Api

Ho provato il tuo codice...
Ho dovuto terminare Excel con: Control-alt-canc se seleziono la barra del msgbox per qualche secondo
Come puoi garantire il corretto utilizzo?

di DPG70 (utente non iscritto) data: 05/12/2014 22:01:01
Inserendo il codice da me riportato precedentemente in Windows 7 - Excel 2013 e provando più volte la macro funziona nella mia macchina.
Per questo mi sono preso la responsabilità di spuntare la discussione, non toglie che in futuro mi accorga di incompatibilità o errori ora non esposti alla mia scarsa conoscenza del linguaggio VBA.
Fatemi sapere se anche per altri pellegrini del forum si creano errori con il mio listato, cosi da indurmi a togliere la spunta di risolta.

..... ai prossimi visitatori perciò, sempre in campana.

Un saluto, DPG.

Sub Filtri()

Dim obj As Object
Dim strMsg As String
Set obj = CreateObject("WScript.Shell")

If Range("F8").Value = "non trovato" Then
  'riproduco un segnale acustico di avviso
  Beep
    'Popup Message Box si chiuderà automaticamente da solo dopo 2 secondi
    strMsg = obj.popUp("Codice di iserimento in F8 non trovato !!!", 2, "Codice", vbOKCancel)
 Exit Sub

........ altro codice .......

End Sub

Vuoi Approfondire?