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为a String,以及其他所有内容Variant.我不认为这是你的意图.
• Select Case最好与Enum价值观一起使用; If-ElseIf否则使用构造.

根据以下评论进行轻微修改:

如何捕获用户输入以执行写入文件之类的操作

现在,如果您想对有效的用户输入执行某些操作,比如将它们写入文件,则需要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问题没有给您答案(稍微不大),请随时提出另一个问题!