如何在VBA中锁定msgbox弹出窗口

Question

我正在为愚人节设置一个办公室恶作剧，当一个问题的答案被错误回答时，会弹出一个弹出窗口（Msgbox），我希望它不会消失。他们的想法是，他们的屏幕会被这些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

：）