Discussion :

[tmolle60]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[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

[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

[mfoxy]

Bonjour,

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

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

Bât

[Patrice740]

Bonjour,

Avec l'API :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[boisgontierjacques]

Bonjour,

Formulaire auto-fermant au bout de 10 secondes.

Dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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!

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[tmolle60]

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

[Pierre Fauconnier]

Salut

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[OrDonc]

...

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 !

[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...

[...]
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