4

パワーポイント VBA でポップアップの質問を作成しようとしていますが、これまでのところ問題ありません。しかし、以下のコードは機能していないようです。アイデアは、100 から 200 (両端を含む) の値を入力するポップアップ ボックスを取得することです。ただし、値を入力する必要があるかfailed、入力として受け入れることができます。入力ボックスをキャンセルしたり、null/空の応答にすることはできません。内側のループ (ループ 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

誰でも私に問題を指摘できますか？よろしくお願いします。これはより大きなコード プロジェクトの一部ですが、この部分が機能していません。このコードを単一のファイルに分離して、問題を解決するために単独で実行しました。

4

3 に答える 3

10

何が起こっているのかをよりよく理解するには、コードをできる限り実行しないように記述する必要があります。現在、非常に多くのことを行う 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 CaseEnum値とともに使用するのが最適です。それ以外の場合は、構造を使用If-ElseIfしてください。

以下のコメントに従って、わずかな変更：

ファイルへの書き込みなどを行うためにユーザー入力をキャプチャする方法

有効なユーザー入力で何かをしたい場合、たとえばそれらをファイルに書きたい場合GetTestCriteriaは、入力を返す必要がありますが、その関数はすでにBoolean. 1 つの解決策は、「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 に関する質問に答えがない場合 (ほとんどありません)、遠慮なく別の質問をしてください。

于 2014-11-06T04:12:39.290 に答える
4

一般的なアプローチとしての Retailcoder の回答は一流です。IsNumeric()ほとんどの問題を解決するものを使用することに特に注意を払いたいと思います。現在、数値以外の文字列が入力されると、コードは失敗します。

コードを見て、少なくとも何が起こっているのかを答えて、好奇心をなだめられるかどうかを確認しました。2 番目のループから抜けられないように見えたとおっしゃいました。実際には、最初のループを終了できませんでした。のせいだったに違いないStrPtr(InputvarTemp) = 1。私も調べてみないと何のことかわかりませんでした。要するに、キャンセルが押されたかどうかを確認したり、変数の基になるメモリアドレスを取得したりするために使用された、文書化されていない機能です (明らかに)。

最初のループが終了する前に、デバッグのためにこれを入れました

MsgBox Len(InputvarTemp) & " " & msgResult & " " & StrPtr(InputvarTemp) & " " & IsNull(InputvarTemp)

InputBox に「150」と入力すると、メッセージ ボックスの結果は次のようになります。3 番目の値は、StrPtr(InputvarTemp)

3 6 246501864 FALSE

246501864 は 1 より大きいため、ループの終了が失敗します。繰り返しになりますが、retailcoder は優れた回答をしており、私は彼の車輪を再発明するつもりはありません。

于 2014-11-06T05:42:48.667 に答える