VBA DO 循环问题

Question

我正在尝试在 powerpoint VBA 中创建一个弹出问题，到目前为止一切顺利。但是下面的代码似乎不起作用。想法是你会得到一个弹出框，其中的值在 100 - 200(含)之间输入。但必须输入一个值，否则可以接受failed作为输入。输入框不能被取消或空/空响应。内循环(循环 1)似乎工作正常，但如果我输入 150它不会终止循环 2 而是继续运行，除非键入失败，但它会以任何文本停止，而不仅仅是 "failed" .

Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)

    'Declare Variables
    Dim xType, xLimitHi, xLimitLo, xPrompt As String
    Dim InputvarTemp As String
    Dim msgResult As Integer

    xLimitHi = 200
    xLimitLo = 100
    xPrompt = "Enter Value between 100 and 200 (Inclusive)"
    Do 'loop 2 check within limit or failed
        msgResult = vbNo
        Do 'loop 1 check Empty / Null or Cancelled input
            InputvarTemp = InputBox(xPrompt, xPrompt)
            If StrPtr(InputvarTemp) = 0 Then ' Check if cancelled is pressed
                MsgBox "Invalid Input - Cannot be cancelled", 16, "Invalid Input."
            Else
                If Len(InputvarTemp) = 0 Then ' Check Null response
                    MsgBox "Invalid Input - Cannot be Empty / Null ", 16, "Invalid Input."
                Else
                    msgResult = MsgBox("You have Entered " & InputvarTemp, vbYesNo + vbDefaultButton2, "Check Value in between " & xLimitLo & " to " & xLimitHi & "(Inclusive)")
                    If CDec(InputvarTemp) < 100 Or CDec(InputvarTemp) > 200 Then ' Check within Limits
                        MsgBox "Invalid Input - Not Within Limit", 16, "Invalid Input."
                    End If
                End If
            End If
        Loop Until Len(InputvarTemp) > 0 And msgResult = vbYes And StrPtr(InputvarTemp) = 1 And IsNull(InputvarTemp) = False 'loop 1 check Empty / Null or Cancelled input
    Loop Until CDec(InputvarTemp) >= 100 And CDec(InputvarTemp) <= 200 Or InputvarTemp = "Failed" 'loop 2 check within limit

    Select Case InputvarTemp
        Case "Failed"
            MsgBox "Test Criteria Failed, Contact Production Engineer", 16, "Failed Test Criteria."
        Case Else
            MsgBox "Test Criteria Passed", 16, "Passed Test Criteria."
    End Select

End Sub

谁能指出我的问题？提前谢谢了。这是一个更大的代码项目的一部分，但这部分不起作用我已将此代码隔离到单个文件中以自行运行以找出问题。

Answer 1

为了更好地理解发生了什么，您需要以尽可能少的方式编写代码；现在你有一个单一的程序可以做很多事情，很难确切地说出哪里出了问题以及哪里出了问题。

编写一个函数来确认用户的有效数字输入:

Private Function ConfirmUserInput(ByVal input As Integer) As Boolean
    ConfirmUserInput = MsgBox("Confirm value: " & CStr(input) & "?", vbYesNo) = vbYes
End Function

然后编写一个函数来处理用户的输入:

Private Function IsValidUserInput(ByVal userInput As String,_
                                  ByVal lowerLimit As Double, _
                                  ByVal upperLimit As Double) _
As Boolean

    Dim result As Boolean
    Dim numericInput As Double

    If StrPtr(userInput) = 0 Then
        'msgbox / cannot cancel out

    ElseIf userInput = vbNullString Then
        'msgbox / invalid empty input

    ElseIf Not IsNumeric(userInput) Then
        'msgbox / must be a number

    Else
        numericInput = CDbl(userInput)
        If numericInput < lowerLimit Or numericInput > upperLimit Then
            'msgbox / must be within range

        Else
            result = ConfirmUserInput(numericInput)

        End If
    End If

    IsValidUserInput = result

End Function

这个函数可能可以用更好的方式编写，但它仍然会返回 False如果任何验证规则失败，或者用户未确认其有效输入。现在你已经准备好进行循环了，而且由于所有复杂的逻辑都被提取到它自己的函数中，循环体变得非常容易理解:

Private Function GetTestCriteria(ByVal lowerLimit As Double, _
                                 ByVal upperLimit As Double) As Boolean

    Const failed As String = "Failed"

    Dim prompt As String
    prompt = "Enter Value between " & lowerLimit & _
             " and " & upperLimit & " (Inclusive)."

    Dim userInput As String
    Dim isValid As Boolean

    Do 

        userInput = InputBox(prompt, prompt)
        isValid = IsValidUserInput(userInput, lowerLimit, upperLimit) _
                  Or userInput = failed

    Loop Until IsValid

    GetTestCriteria = (userInput <> failed)

End Sub

OnSlideShowPageChange程序现在看起来像这样:

Private Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)

    If GetTestCriteria(100, 200) Then
        MsgBox "Test criteria passed."
    Else
        MsgBox "Test criteria failed, contact production engineer."
    End If

End Sub

我没有测试过任何这些代码，但我确信调试这些更专业的功能会比调试你的整体代码更容易；通过提取这些函数，您可以解开逻辑，我敢打赌上面的内容正是您想要做的。另请注意:

Dim xType, xLimitHi, xLimitLo, xPrompt As String声明 xPrompt作为 String ，以及其他所有内容为 Variant .我不认为这是你的意图。

Select Case最好与 Enum 一起使用值(value)观；使用 If-ElseIf否则构造。

稍微修改，根据以下评论:

how do i capture the user input to do something like write to a file

现在，如果你想对有效的用户输入做一些事情，比如将它们写入文件，你需要 GetTestCriteria返回输入 - 但该函数已经返回 Boolean .一种解决方案可能是使用“out”参数:

Private Function GetTestCriteria(ByVal lowerLimit As Double, _
                                 ByVal upperLimit As Double, _
                                 ByRef outResult As Double) As Boolean

    Const failed As String = "Failed"

    Dim prompt As String
    prompt = "Enter Value between " & lowerLimit & _
             " and " & upperLimit & " (Inclusive)."

    Dim userInput As String
    Dim isValid As Boolean

    Do 

        userInput = InputBox(prompt, prompt)
        isValid = IsValidUserInput(userInput, lowerLimit, upperLimit, outResult) _
                  Or userInput = failed

    Loop Until IsValid

    GetTestCriteria = (userInput <> failed)

End Sub

Private Function IsValidUserInput(ByVal userInput As String,_
                                  ByVal lowerLimit As Double, _
                                  ByVal upperLimit As Double, _
                                  ByRef outResult As Double) _
As Boolean

    Dim result As Boolean
    Dim numericInput As Double

    If StrPtr(userInput) = 0 Then
        'msgbox / cannot cancel out

    ElseIf userInput = vbNullString Then
        'msgbox / invalid empty input

    ElseIf Not IsNumeric(userInput) Then
        'msgbox / must be a number

    Else
        numericInput = CDbl(userInput)
        If numericInput < lowerLimit Or numericInput > upperLimit Then
            'msgbox / must be within range

        Else
            result = ConfirmUserInput(numericInput)
            outResult = numericInput
        End If
    End If

    IsValidUserInput = result

End Function

现在你可以在 OnSlideShowPageChange 中调用一个方法, 将有效结果写入文件:

Private Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)

    Dim result As Double

    If GetTestCriteria(100, 200, result) Then
        MsgBox "Test criteria passed."
        WriteResultToFile result
    Else
        MsgBox "Test criteria failed, contact production engineer."
    End If

End Sub

如果您在执行此操作时遇到问题 WriteResultToFile程序，并且现有的 Stack Overflow 问题无法为您提供答案(不太可能)，请随时提出另一个问题!