Fermer Userform après délai

**fdseab** · 02/12/2018, 16h07

Bonjour à tous,
après avoir parcouru ce forum (et d'autres) je n'ai pas réussi à trouver une solution à mon problème.
Pour un projet, je dois créer un jeu type Fight List pour ceux qui connaissent. Le joueur doit entrer un maximum de mots en rapport avec un thème donné, le tout en un temps limité.
Le problème c'est que je ne sais pas comment faire pour que l'Userform où le joueur entre ses réponses se ferme au bout d'une minute, sans que cela ne bloque les actions (saisie et affichage des mots). J'avais cru trouver un solution via des procédures mais je n'arrive pas à inclure l'utilisation du bouton de validation...

Quelqu'un aurait-il une idée ?

Je laisse ici le code de mon Userform

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
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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
Option Explicit
Private theme As Integer
Private score As Integer
Private reps(1000) As Integer
Private nbReps As Integer
 
Public Property Let setTheme(themeEnCours As Integer)
    theme = themeEnCours
    LabelTheme.Caption = Sheets("reponses").Cells(1, theme)
End Property
 
Public Property Get recupScore()
    recupScore = score
End Property
 
Private Sub UserForm_Initialize()
 
    theme = 13
    score = 0
    nbReps = 0
 
        With LabelTheme
            .Object.Caption = Sheets("reponses").Cells(1, theme)
            .Font.Name = "Times New Roman"
            .Font.Size = 14
            .Left = 12
            .Top = 6
            .Width = 396
            .Height = 30
            .TextAlign = 2
        End With
 
        With ListBoxReponses
            .Font.Name = "Times New Roman"
            .Font.Size = 10
            .Left = 12
            .Top = 60
            .Width = 400
            .Height = 321
            .ColumnCount = 3
            .ColumnWidths = "130;150"
            .TextAlign = 2
        End With
 
        With CommandButtonValider
            .Object.Caption = "Valider"
            .Font.Name = "Times New Roman"
            .Font.Size = 10
            .Left = 336
            .Top = 384
            .Width = 76
            .Height = 24
            .Default = True
        End With
 
        With TextBoxSaisie
            .SetFocus
            .Font.Name = "Times New Roman"
            .Font.Size = 10
            .Left = 12
            .Height = 18
            .Top = CommandButtonValider.Top + (CommandButtonValider.Height - TextBoxSaisie.Height) / 2
            .Width = 312
        End With
 
End Sub
 
Private Sub tempsEcoule()
    MsgBox ("Le temps est écoulé")
    Me.Hide
End Sub
 
Private Function SupprSpecialCharacters(ByVal phrase As String) As String
 
    Dim j As Integer
 
    Const listeAccents = "àáâãäåéêëèìíîïðòóôõöùúûü'-,.&#@/*+()_""", lettresSansAccents = "aaaaaaeeeeiiiioooooouuuu               "
 
    For j = 1 To Len(listeAccents)
        phrase = Replace(phrase, Mid(listeAccents, j, 1), Mid(lettresSansAccents, j, 1))
    Next j
 
    SupprSpecialCharacters = phrase
 
End Function
 
Private Function ComparativeString(ByVal phrase As String) As String
 
    Dim j As Integer
 
    phrase = Replace(SupprSpecialCharacters(phrase), " ", "")
 
    ComparativeString = UCase(phrase)
 
End Function
 
Private Function AnswerVerification(ByVal answer As String) As Integer
 
    Dim i, j As Integer
 
    i = 2
 
    answer = ComparativeString(answer)
 
    While Sheets("reponses").Cells(i, theme).Value <> ""
 
        If answer = ComparativeString(Sheets("reponses").Cells(i, theme).Value) Then
 
            For j = 0 To nbReps
                If reps(j) = i Then
                    AnswerVerification = 0
                    Exit Function
                End If
            Next j
 
            AnswerVerification = i
            reps(nbReps) = i
            nbReps = nbReps + 1
            Exit Function
        End If
 
        i = i + 1
 
    Wend
 
    AnswerVerification = -1
 
End Function
 
Private Sub AffichageBonneReponse(position As Integer)
 
    Dim n As Variant
 
    n = ListBoxReponses.ListCount
 
    ListBoxReponses.AddItem
 
    ListBoxReponses.List(n, 0) = Sheets("reponses").Cells(position, theme)
    ListBoxReponses.List(n, 2) = Sheets("reponses").Cells(position, theme + 1)
 
End Sub
 
Private Sub AffichageMauvaiseReponse()
 
    Dim n As Variant
 
    n = ListBoxReponses.ListCount
 
    ListBoxReponses.AddItem
 
    ListBoxReponses.List(n, 1) = TextBoxSaisie.Value
    ListBoxReponses.List(n, 2) = 0
 
End Sub
 
Private Sub CommandButtonValider_Click()
 
    Dim cellule As Integer
 
         cellule = AnswerVerification(TextBoxSaisie.Value)
 
         If cellule = -1 Then
             Call AffichageMauvaiseReponse
         ElseIf cellule > 0 Then
             Call AffichageBonneReponse(cellule)
             score = score + Sheets("reponses").Cells(cellule, theme + 1).Value
         End If
 
 
         TextBoxSaisie.Value = ""
 
         TextBoxSaisie.SetFocus
 
         SaisieReponses.Repaint
 
End Sub

**patricktoulon** · 02/12/2018, 16h21

re
dans un module standard

Code :

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

1
2
3
Sub ferme()
Unload userform1 'adapter le nom du userform
End Sub

dans le activate de l'userform

Code :

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

Application.OnTime Now + TimeValue("00:01:00"), "ferme"

**fdseab** · 03/12/2018, 13h50

Cette solution me permet bien d'utiliser le Userform mais celui ci ne se ferme pas au bout du temps donné dans le OnTime...

**Theze** · 04/12/2018, 16h11

Bonjour,

Alors, tu n'as pas fais les manips indiquées par Patrick !

**MarcelG** · 04/12/2018, 16h51

Salut à vous,

En règle générale, la syntaxe mise à part.
Y a-t-il une réelle différence entre les méthodes Wait et Ontime?

Code :

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

1
2
If Application.Wait(Now + TimeValue("0:01:00")) Then 
  Call ferme

**patricktoulon** · 04/12/2018, 18h23

Bonsoir Marcel

grave erreur de comparer wait a app.ontime
il n'ont absolumnent rien voir l'un est l'autre
wait stop VBA a chaque pose
on time quand il n'est pas declanché ne fait rien
en gros et autrement dit vba n'est pas bloqué sur pose entre deux executions et ca fait une tres large difference

**MarcelG** · 05/12/2018, 10h53

Bonjour Patrick, Bonjour le Forum,

OK. Merci.
Passe une bonne journée.

Fermer Userform après délai

Macros et VBA Excel

Discussions similaires

Partager

Partager