Как заблокировать всплывающие окна msgbox в VBA

Question

Я настраиваю офисную шутку на апрельских дураков, чтобы при неправильном ответе на вопрос всплыло всплывающее окно (Msgbox), и я хочу, чтобы оно не исчезло.Идея в том, что их экран будет забиваться этими сообщениями, пока они не получат правильные вопросы.Я не уверен, как это сделать, хотя.Любая помощь будет принята с благодарностью!

Вот текущий код:

 Sub Button1_Click()

Dim ws As Worksheet
Dim a As String
Dim b As String
Dim c As String
Dim Ret As Variant

'Lockout Functions
'Cancel = True

'Hal2001 Takes Over
Set ws = ThisWorkbook.Sheets("Hal2001")
Sheets("Hal2001").Visible = True
Sheets("Hal2001").Select

Ret = MsgBox("Would you like to play a game?", vbYesNo)
Application.Speech.Speak "I'm sorry I cannot let you do that, Would you like to play a game?"

If Ret = vbNo Then
Application.Speech.Speak "Well I want to play a game, so we are going to play one"
Else
Application.Speech.Speak "Then Lets Begin"
End If

'First Question
a = Application.InputBox("The Declaration of Independence was signed on what day?")
If a = "July 2nd 1776" Then 'continue
Else
Do While a = Application.InputBox("The declaration of independence was signed on what day?") < 100
Application.Speech.Speak "Are you even trying?"
MsgBox "You really don't know when the Declaration of Independence was signed??"
Loop
End If

'Second Question
b = Application.InputBox("Finish this Sequence 1123_813__")
If b = "1123581321" Then 'Continue
Else
Do While b = Application.InputBox("Finish this Sequence 1123_813__") < 100
Application.Speech.Speak "10, 9, 8, 7, 6, 5, 4, 3, 2, 1!"
MsgBox "Hi, you got that answer wrong"
Loop
End If

'How about some music
Application.Speech.Speak "How about some music?"
Ret = MsgBox("How about some music?", vbYesNo)
If Ret = vbNo Then
Application.Speech.Speak "Too bad, here is one from the eighties you will like."
Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url https://www.youtube.com/watch?v=oHg5SJYRHA0")
Else
Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url https://www.youtube.com/watch?v=oHg5SJYRHA0")
End If


'Third Question
c = Application.InputBox("What are the next three numbers 1,4,9,16,?")
If c = "1,4,9,16,25,36,49" Then 'continue
Else
Do While c = Application.InputBox("What are the next three numbers 1, 4, 9, 16, ?") < 100
'Application.Speech.Speak "Terrible!"
MsgBox "Hi, you got that answer wrong. Don't you love these pop up boxes?"
Loop
End If

'Unlock/Return Control
Application.Speech.Speak "Congradulations! You survived our April Fools 
Joke! Happy April Fools!"
ActiveWindow.SelectedSheets.Visible = False
'Cancel = False
End Sub

Answer 1

Этот пример должен вам помочь:

Option Explicit

Public Sub TestQuestion()

    Dim StopAfter As Long
    StopAfter = 100 'to stop after 100 times asking
    Do While Application.InputBox("The Declaration of Independence was signed on what day?") <> "July 2nd 1776" And StopAfter > 0
        Application.Speech.Speak "Are you even trying?"
        MsgBox "You really don't know when the Declaration of Independence was signed?"
        StopAfter = StopAfter - 1
    Loop

End Sub

Answer 2

Просто чтобы дать вам представление о том, как это может кого-то расстроить:

Мой лист:

Мой макрос:

Dim X As Double

Option Explicit

Sub Test()

With ActiveWorkbook.Sheets(1)
    For X = 2 To 4
        Do While .Cells(X, 4) <> .Cells(X, 3)
            .Cells(X, 4) = Application.InputBox(.Cells(X, 2))
        Loop
    Next X
End With

End Sub

:)