Unload userform after x seconds for a quiz?

RockandGrohl

Well-known Member
Joined
Aug 1, 2018
Messages
790
Office Version
  1. 365
Platform
  1. Windows
Hi guys, can I unload a userform if the answer is not provided in a text box within 5 seconds?

VBA Code:
Application.OnTime Now + TimeValue("00:00:05"), "KillForm1"

That's some code I've found, but surely the code will just hang on that for 5 seconds, right? I want to have an image show up in the userform. If the user guesses the correct subject, then it moves on to the next image. They have 5 seconds to guess each image.

The part I'm struggling with is how to time it in the background. Thanks!
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
I think the OnTime method could suffice, although sometimes it could be a fraction less than five seconds and other times it could be a fraction more than five seconds.
When this method is used, the following steps should be coded.
  • One has to add a custom method to the UserForm that takes care of switching the required images.
  • That method can then be invoked by a publicly declared macro in a standard module which in turn is executed by the OnTime method of the Application object.
  • The macro executed by the OnTime method will have to be rescheduled to achieve a 5 second interval.
  • If the user gives a correct answer, every last scheduled OnTime will have to be canceled while a new one has to be placed in the schedule afterwards.
  • Finally, if the UserForm terminates the last scheduled OnTime will have to be canceled.
Coding all this could be a real challenge, but imho not impossible.
 
Upvote 0
So this is what my code will look like.. approximately.. I'm very rusty at VBA I haven't used it in ages.

VBA Code:
Load Quiz
Quiz.Show vbModeless

Quiz.Image1.Visible = True
Quiz.Image2.Visible = False
'Quiz.Image3.Visible = False
'Quiz.Image4.Visible = False
'Quiz.Image5.Visible = False
'Quiz.Image6.Visible = False
'Quiz.Image7.Visible = False
'Quiz.Image8.Visible = False
'Quiz.Image9.Visible = False

x = 1

Do Until x = 9

Application.OnTime Now + TimeValue("00:00:05"), "UnloadIt"
If x = 1 Then
    If UCase(Quiz.InputBox.Text) <> "ANSWER1" Then
    Call UnloadIt
    Else
    Image1.Visible = False
    Image2.Visible = True
    End If
End If

If x = 2 Then
    If UCase(Quiz.InputBox.Text) <> "ANSWER2" Then
    Call UnloadIt
    Else
    Image2.Visible = False
    Image3.Visible = True
    End If
End If

x = x + 1
Loop




End Sub

Public Sub UnloadIt()
  
   Unload Quiz
     
End Sub


That's essentially what I need to do.

Trouble is, the code just loops and closes after the 9th loop. I need the Userform to load and give the user 5 seconds to input an answer into the textbox. If the answer is correct the next iteration of the loop happens, where the first image is unloaded and the 2nd is loaded, and therefore the next answer must be given.

What's happening is because the code is not being halted for an input, it's closing immediately. How do I halt for input without using an input box?
 
Last edited:
Upvote 0
One of our long-time members created a timed InputBox which works really well. Give this a look.

 
Upvote 0
I think another approach would propably be better in this case. Let me think about that for a few moments ...
 
Upvote 0
One of our long-time members created a timed InputBox which works really well. Give this a look.

Hi Eric
I'm trying to have a Userform show an image with a text-input below it. The user must input the answer within 5 seconds else the whole form closes and they must start again. If the correct answer is chosen, a new image will appear and the 5 second timer will be refreshed. I'm not sure this is possible with the link you showed me because it appears to just run off a modified InputBox

Thanks
 
Upvote 0
I think another approach would propably be better in this case. Let me think about that for a few moments ...
Yep, so in essence

User starts the quiz

Image is loaded and 5s timer starts. If the user inputs the correct answer then a new image is loaded and the timer is refreshed. If the correct answer is not given, the whole form closes down and the user must start again.

Cheers.
 
Upvote 0
I'm not sure this is possible with the link you showed me because it appears to just run off a modified InputBox
Actually I do think @Jaafar Tribak's code is suitable for what you're trying to do.
Although my approach would look slightly different, I've now modified your code, using Eric's suggestion.
You just need to change both the Prompt and Title strings.

EDIT:
Forgot to mention that either way you will have to provide a submit button, otherwise your code will continue and the user will not even get the chance to enter anything.
Jaafar's code takes that into account.

VBA Code:
Load Quiz
Quiz.Show vbModeless

Quiz.Image1.Visible = True
Quiz.Image2.Visible = False
'Quiz.Image3.Visible = False
'Quiz.Image4.Visible = False
'Quiz.Image5.Visible = False
'Quiz.Image6.Visible = False
'Quiz.Image7.Visible = False
'Quiz.Image8.Visible = False
'Quiz.Image9.Visible = False

x = 1

Do Until x = 9

Dim UserInput As String

If x = 1 Then
    UserInput = VBA.UCase(Timed_InputBox(Prompt:="Enter Some Text :", Title:="Time-Out InputBox Demo.", SecondsTimeOut:=5, ShowCountDown:=True))
    If UserInput <> "ANSWER1" Then
        Call UnloadIt
    Else
        Image1.Visible = False
        Image2.Visible = True
    End If
End If

If x = 2 Then
    UserInput = VBA.UCase(Timed_InputBox(Prompt:="Enter Some Text :", Title:="Time-Out InputBox Demo.", SecondsTimeOut:=5, ShowCountDown:=True))
    If UserInput <> "ANSWER2" Then
        Call UnloadIt
    Else
        Image2.Visible = False
        Image3.Visible = True
    End If
End If

x = x + 1
Loop
 
Last edited:
Upvote 0
Actually I do think @Jaafar Tribak's code is suitable for what you're trying to do.
Although my approach would look slightly different, I've now modified your code, using Eric's suggestion.
You just need to change both the Prompt and Title strings.

EDIT:
Forgot to mention that either way you will have to provide a submit button, otherwise your code will continue and the user will not even get the chance to enter anything.
Jaafar's code takes that into account.

VBA Code:
Load Quiz
Quiz.Show vbModeless

Quiz.Image1.Visible = True
Quiz.Image2.Visible = False
'Quiz.Image3.Visible = False
'Quiz.Image4.Visible = False
'Quiz.Image5.Visible = False
'Quiz.Image6.Visible = False
'Quiz.Image7.Visible = False
'Quiz.Image8.Visible = False
'Quiz.Image9.Visible = False

x = 1

Do Until x = 9

Dim UserInput As String

If x = 1 Then
    UserInput = VBA.UCase(Timed_InputBox(Prompt:="Enter Some Text :", Title:="Time-Out InputBox Demo.", SecondsTimeOut:=5, ShowCountDown:=True))
    If UserInput <> "ANSWER1" Then
        Call UnloadIt
    Else
        Image1.Visible = False
        Image2.Visible = True
    End If
End If

If x = 2 Then
    UserInput = VBA.UCase(Timed_InputBox(Prompt:="Enter Some Text :", Title:="Time-Out InputBox Demo.", SecondsTimeOut:=5, ShowCountDown:=True))
    If UserInput <> "ANSWER2" Then
        Call UnloadIt
    Else
        Image2.Visible = False
        Image3.Visible = True
    End If
End If

x = x + 1
Loop
Hi,

I added the TimedInputBAS module

This is what the top bit looks like

VBA Code:
Option Explicit

    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr

Private Const IDCANCEL = &H2
Private Const BM_CLICK = &HF5

I had to remove the other section of it coz it was all errors.

Anyway, when I run this code, my excel just completely crashes randomly.

Seems to be working, but after I input the first answer it doesn't swap out the image for the second question
 
Upvote 0
How about this :
VBA Code:
Sub Test()

    Const DELAY = 5 'secs
    Dim t As Single, i As Long
  
    Load Quiz
    Quiz.Show vbModeless
  
    With Quiz
        For i = 1 To 9
            .Controls("image" & i).Visible = False
            .Controls("image" & i).Tag = "ANSWER" & i
        Next i
        .Image1.Visible = True
        t = Timer: i = 1
        Do While Timer - t <= DELAY
            DoEvents
            If UCase(.InputBox.Text) = .Controls("image" & i).Tag Then
                .InputBox.Text = ""
                .Controls("image" & i).Visible = False
                t = Timer: i = i + 1
                .Controls("image" & i).Visible = True
            End If
        Loop
    End With
    Unload Quiz
  
End Sub

EDIT:

I assume InputBox is the name you have given to a Textbox Control (Not an actual vba InputBox) in the userform Quiz.
 
Upvote 0

Forum statistics

Threads
1,215,053
Messages
6,122,888
Members
449,097
Latest member
dbomb1414

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top