Fermer un userform en validant ou apres X secondes

Version imprimable

20/01/2020, 23h22
tmolle60

Fermer un userform en validant ou apres X secondes
Bonsoir

Je cherche les codes vba pour fermer un userform soit en cliquant sur un bouton ou si non action sur ce bouton
une fermeture automatique après 20 secondes

j'ai ajouté cela dans mon userform:
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub UserForm_Activate() Application.Wait Now + TimeValue("00:00:20") Unload Me End Sub Private Sub VALIDER_Click() UserForm1.Hide End Sub
L'automatique fonction mais je ne peux plus cliquer pour le fermer.

Merci pour votre aide.
21/01/2020, 03h12
ARTURO83

Bonjour,

Le bouton ne sert à rien, si vous voulez arrêtez la macro "Private Sub UserForm_Activate()", appuyez simplement sur la touche "Echap" ce qui a pour effet d'interrompre la macro et de fermer le formulaire.

Cdlt
21/01/2020, 09h32
tmolle60

Oui mais je souhaiterais avoir les deux possibilité, repondre a une question sur la userform et valider la reponse ou en cas de non reponse
fermer la userform apres une vingtaine de secondes.
Merci pour votre aide
21/01/2020, 11h49
mfoxy

Bonjour,

Peut-être cette contribution de PatrickToulon te mettra sur la voie.

https://www.developpez.net/forums/bl...-etc-userform/

Bât

Bonjour,

Avec l'API :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Private Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
  ByVal hwnd As Long, _
  ByVal lpText As String, _
  ByVal lpCaption As String, _
  ByVal uType As Long, _
  ByVal wLanguageID As Long, _
  ByVal lngMilliseconds As Long) As Long
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
  ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long
 
Private Sub CommandButton1_Click()
 
  ActiveCell.Activate
  MsgBoxTemporaire (2000)
 
End Sub
 
Private Sub MsgBoxTemporaire(durée As Long)
' Affiche une boite de message temporaire
'
' Arguments : durée               [in]  Durée d'affichage en millisecondes
'
Const msg As String = "Msgbox avec tempo de 2s"
Const title As String = "Popup"
Const timeOut As Integer = 32000
Dim retval As Long
Dim boutons As Long
 
  boutons = vbSystemModal + vbYesNoCancel + vbInformation  'au minimum : modal
 
  retval = MessageBoxTimeout(FindWindow(vbNullString, title), msg, title, boutons, 0, durée) 'en ms
 
  If retval = timeOut Then
   MsgBox "Pas de réponse, tempo atteinte"
  ElseIf retval = vbYes Then
    MsgBox "Oui"
  ElseIf retval = vbNo Then
    MsgBox "Non"
  ElseIf retval = vbCancel Then
    MsgBox "Annuler"
  End If
 
End Sub

1 pièce(s) jointe(s)

Bonjour,

Formulaire auto-fermant au bout de 10 secondes.

Dans un module

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim temps
 
Dim temps
Sub démarre()
 temps = Now + TimeValue("00:00:10")
 Application.OnTime temps, "fin"
End Sub
 
Sub fin()
  Unload UserForm1
  auto_close
End Sub
 
Sub auto_close()
 On Error Resume Next
 Application.OnTime temps, Procedure:="fin", Schedule:=False
End Sub

Dans le formulaire

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub UserForm_Initialize()
  démarre
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  auto_close
End Sub
 
Private Sub b_fin_Click()
 auto_close
 Unload Me
End Sub

Il ne faut pas oublier:
Application.OnTime temps, Procedure:="fin", Schedule:=False

Boisgontier

2 pièce(s) jointe(s)

Bonsoir …
Je ne comprends pas pourquoi, dans plus de 99% des propositions, je vois ajouté un nouveau bouton Quitter alors que le bandeau du Formulaire contient déjà la croix X!

avec la croix (pas 2 mais 3 sorties éventuelles)
dans la fenêtre des codes du formulaire Voir

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Dim t As Byte, F As Boolean
Private Sub Fin_Click()
    t = 20  'durée en seconde
    F = Not F: Fin.ControlTipText = "clic pour quitter"
    'lancement décompte 
    Do
        Application.Wait (Now + TimeValue("00:00:01"))
        t = t - 1: Me.Caption = t & " s"
        DoEvents
    Loop Until t = 0 or F = 0
    Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    End  'croix
End Sub

Ce nouveau bouton sera obligatoire si la croix a été supprimée (API) du bandeau du formulaire.
sans la croix
- Dans un Module Standard (pour supprimer la croix)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Declare Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Sub Va()    'sans croix
    Dim hWnd As Long
    hWnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
                       "X", "D") & "Frame", Voir.Caption)
    SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF
    Voir.Show
End Sub

- Dans Voir (où Fin est un bouton bascule)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Fin_Click()
    Dim t As Byte 'durée en seconde
    t = 20
    If Fin Then
        Fin.ControlTipText = "clic pour quitter"
        Do
            Application.Wait (Now + TimeValue("00:00:01"))
            t = t - 1: Fin.Caption = t & " s"
            DoEvents
        Loop Until t = 0
    End If
    End
End Sub

23/01/2020, 12h31
merymad69
Et juste en rajoutant ce bout de code, je l'utilise dans un formulaire pour fermer le userform automatiquement 3 secondes après une action bien précise (le CommandButton2 étant le bouton quitter de la userform) :
Code:

1 2 3 4 5 6 7 For i = 3 To -1 Step -1 If Application.Wait(Now + TimeValue("00:00:01")) Then DoEvents CommandButton2.Caption = i & " Sec" End If Next Unload Me
23/01/2020, 22h08
tmolle60

Merci a tous.mon problème est résolu.
Bonne soirée

Salut

Citation:

Envoyé par OrDonc

Bonsoir …
Je ne comprends pas pourquoi, dans plus de 99% des propositions, je vois ajouté un nouveau bouton Quitter alors que le bandeau du Formulaire contient déjà la croix X![...]

C'est parce que tu penses à tort que les deux actions produisent le même effet, alors que ce qui se passe après la fermeture du userform n'est pas du tout la même chose. Le bouton "Fermer" permet de masquer le formulaire en le gardant en mémoire pour en exploiter les propriétés, alors que le clic sur la croix décharge le formulaire de la mémoire, et cela ne permet plus de l'exploiter (en récupérer les données saisies, par exemple).

Crée un formulaire, places-y un bouton et le code suivant:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Option Explicit Public Result As String Private Sub CommandButton1_Click() Result = "Fermeture par bouton de commande" Me.Hide End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Result = "Fermeture via la croix rouge" End Sub
Dans un module normal, place le code qui appelle le formulaire et qui en récupère les valeurs après fermeture.
Code:

1 2 3 4 Sub Test1() UserForm1.Show MsgBox UserForm1.Result End Sub
Que constates-tu? Qu'en cliquant sur le bouton, tu récupères la valeur de Result pour l'afficher (mais tu pourras aussi récupérer les valeurs des contrôles), alors qu'en cliquant sur la croix, le message n'affiche pas le texte "Fermeture via la croix rouge" car le userform a été déchargé au moment du clic, puis rechargé pour afficher userform1.result qui est une chaine vide.

07/02/2020, 12h24
OrDonc

...

Citation:

Envoyé par Pierre Fauconnier

C'est parce que tu penses à tort que les deux actions produisent le même effet ...

Qu’est-ce qui te permet de dire cela ?
Prétendre lire dans les pensées, c’est bien présomptueux de ta part !:furieux:
07/02/2020, 12h29
Pierre Fauconnier

En quoi est-ce une "pensée" dans laquelle je lirais?

Ce qui me fait dire que tu ne connais pas la différence de comportement, c'est simplement ta remarque...

Citation:

Envoyé par OrDonc

[...]
Je ne comprends pas pourquoi, dans plus de 99% des propositions, je vois ajouté un nouveau bouton Quitter alors que le bandeau du Formulaire contient déjà la croix X![...]

Si tu savais que le bouton et la croix n'ont pas le même comportement, tu comprendrais forcément pourquoi, dans 99% des propositions, on ajoute un bouton, et tu ne dirais pas que tu ne comprends pas pourquoi... CQFD