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 值一起使用；否则使用 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 问题没有为您提供答案（不太可能），请随时提出另一个问题！

Answer 2

作为一般方法，Retailcoder 的回答是一流的。我想特别提请注意IsNumeric() 的使用，这将解决大多数问题。目前，如果输入任何非数字字符串，您的代码将失败。

查看了代码以尝试看看我是否至少可以回答正在发生的事情以尝试安抚您的好奇心。您提到看起来您无法离开第二个循环。实际上，我无法退出您的第一个循环。我确定是由于StrPtr(InputvarTemp) = 1。我什至不知道那是什么，直到我查到它。简而言之，它是一个 未记录 功能，用于检查 Cancel 是否被推送/获取变量的底层内存地址（显然）。

在第一个循环结束之前，我把它放进去调试

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

当我在 InputBox 中输入“150”时，消息框的结果如下。第三个值代表StrPtr(InputvarTemp)

3 6 246501864 FALSE

246501864 大于 1 会导致循环退出失败。再一次，retailcoder 有一个很好的答案，我不会重新发明他的轮子。

Answer 3

感谢 @retailcoder 和 @Matt 以下是供任何人使用的完整代码，您的帮助确实得到了利用

使用 Config.ini 将用户输入从 Powerpoint 演示文稿中捕获到文件中，以最大限度地减少日常编程（或对标准用户没有编程代码）

>幻灯片 1 中的代码

    Option Explicit
    Option Compare Text
    Public WithEvents PPTEvent As Application
    Public TimeNow, ToDate As String
    Public WorkOrder, Serial, UserName As String
    Public ReportFile, TempReportFile, TimingFile As String
    Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)

    'Declare Variables
    Dim ShellRun As Long
    Dim INIPath, StartTime, EndTime, TimeDifferance As String ' from Enviorment
    Dim PCPver, ModuleName, PCPFileName, Timed, ResultsFolder, TrainingFolder, TimeingFolder, TrainedFolder, xType, xPrompt, xvarUnit, y As String 'From INI file
    Dim xLimitHi, xLimitLo As Variant
    Dim result As Double
    Dim FailedResult As Double
    Dim PCPverInput, inputvar, InputvarDate, InputvarTrueFalse, InputvarGeneral, InputvarLimit, InputvarTemp As String 'From User
    Dim TrainingFile, SelfCheck, InvalidCharacter1, InvalidCharacter2 As String  'Variables for Filenames
    Dim msgResult, msgResultTemp As Integer
    Dim myVarPass As Boolean
    Dim KeyAscii As Integer 'Try and Hook Esc key
    Dim ppApp As Object
    Const fsoForAppend = 8
    'Declare and create a FileSystemObject.
    Dim fso, ResutlsFSO, TrainingFSO, TimeingFSO As Object 'Need Microsoft Script Runtime in references
    ' Declare a TextStream.
    Dim oFile, ResutlsStream, TrainingStream, TimeingStream As Object

    'Assign Variables
    INIPath = ActivePresentation.Path & "\" & "Config.ini"
    'ShellRun = Shell(ActivePresentation.Path & "\" & "Esc.exe")
    SelfCheck = ActivePresentation.Name
    ToDate = Format(Date, "dd-mmm-yyyy")
    TimeNow = Replace(Format(time, "hh:mm:ss"), ":", "-")
    StartTime = Format(time, "hh:mm:ss")
    'Retrive Folderpaths and create file names
    ModuleName = GetINIString("PCPInfo", "ModuleName", INIPath)
    Timed = GetINIString("Options", "Timed", INIPath)
    Set ResutlsFSO = CreateObject("Scripting.FileSystemObject")
    Set TrainingFSO = CreateObject("Scripting.FileSystemObject")
    Set TimeingFSO = CreateObject("Scripting.FileSystemObject")
    'Retrive PCP version from Ini file
    PCPver = GetINIString("PCPInfo", "PCPver", INIPath)
    PCPFileName = GetINIString("PCPInfo", "PCPFileName", INIPath)
    ResultsFolder = GetINIString("Folders", "ResultsFolder", INIPath)
    TrainingFolder = GetINIString("Folders", "TrainingFolder", INIPath)
    TimeingFolder = GetINIString("Folders", "TimeingFolder", INIPath)
    TrainedFolder = GetINIString("Folders", "TrainedFolder", INIPath)
        Do
            If (SelfCheck <> PCPFileName) Then
                MsgBox "Invalid Config.ini File. Replace with Correct INI file to continue. ", 16, "Invalid Config.ini File."
            End If
        Loop Until (SelfCheck = PCPFileName)
    'Collect PCP version, User Name, Work Order, Serial Number
    If (SSW.View.CurrentShowPosition = 1) Then
        'Retrive PCP Version from BOM - User Input
        Do
            Do
                PCPverInput = InputBox("Enter PCP Number including Version", "Enter PCP Number including Version")
                If (Len(PCPverInput) < 4) Then
                    MsgBox "Invalid Input - PCP version cannot be Empty / Null / cancelled", vbOKOnly, "Invalid Input"
                End If
            Loop Until (Len(PCPverInput) > 4)
            'Check PCPversion against BOM
            If (PCPver <> PCPverInput) Then
                'Display Warning Messages
                MsgBox "Incorrect PCP version. Contact Team Leader / Product Engineer. Cannot Continue the programm", 16, "Incorrect PCP version."
            End If
        Loop Until (PCPver = PCPverInput)
       'Retrive UserName - User Input
        Do
            msgResult = 7
            Do
                UserName = InputBox("Enter / Scan Operator Name", "Enter / Scan Operator Name")
                msgResult = MsgBox("You have Enterd Operator Name " & UserName, vbYesNo + vbDefaultButton2, "Operator Name")
                If (Len(UserName) < 4) Then
                    MsgBox "Invalid Input - User / Operator Name cannot be Empty / Null / cancelled", 16, "Invalid Input"
                End If
            Loop Until (Len(UserName) > 4) And (msgResult = vbYes)
        Loop Until (Len(UserName) > 4)
        'Retrive Work Order
        Do
            msgResult = 7
            Do
                WorkOrder = InputBox("Enter / Scan Work Order", "Enter / Scan Work Order")
                msgResult = MsgBox("You have Enterd Work Order " & WorkOrder, vbYesNo + vbDefaultButton2, "Work Order")
                If (Len(WorkOrder) < 4) Then
                    MsgBox "Invalid Input - Work Order cannot be Empty / Null / cancelled. Minimum 5 Numbers", 16, "Invalid Input"
                End If
            Loop Until (Len(WorkOrder) > 4) And (msgResult = vbYes)
        Loop Until (Len(WorkOrder) > 4)
        'Retrive Serial Number
        Do
            msgResult = 7
            Do
                Serial = InputBox("Enter / Scan Serial Number", "Enter / Scan Serial Number")
                msgResult = MsgBox("You have Enterd Serial Number " & Serial, vbYesNo + vbDefaultButton2, "Serial Number")
                If (Len(Serial) < 1) Then
                    MsgBox "Invalid Input - Serial Number cannot be Empty / Null / cancelled. Use -NOSERIAL- if Not Applicable", 16, "Invalid Input"
                End If
            Loop Until (Len(Serial) > 1) And (msgResult = vbYes)
        Loop Until (Len(Serial) > 1)

        If (Len(Dir(ResultsFolder, vbDirectory)) = 0) Then
        MkDir ResultsFolder
        End If

        If (Len(Dir(ResultsFolder & "\" & WorkOrder, vbDirectory)) = 0) Then
        MkDir ResultsFolder & "\" & WorkOrder
        End If

        If (Len(Dir(ResultsFolder & "\" & WorkOrder & "\" & Serial, vbDirectory)) = 0) Then
        MkDir ResultsFolder & "\" & WorkOrder & "\" & Serial
        End If

        ReportFile = ResultsFolder & "\" & WorkOrder & "\" & Serial & "\" & PCPver & "_" & ToDate & "_" & TimeNow & ".txt"
        Set ResutlsStream = ResutlsFSO.CreateTextFile(ReportFile, True)
        ResutlsStream.WriteLine PCPver & " " & ModuleName & " Build / Test Checklist"
        ResutlsStream.WriteLine "===================================================================================================="
        ResutlsStream.WriteLine ""
        ResutlsStream.WriteLine "Work Order                             :" & WorkOrder
        ResutlsStream.WriteLine "Serial Number (if Applicable)          :" & Serial
        ResutlsStream.WriteLine "Test / Assembly Operator (Full Name)   :" & UserName
        ResutlsStream.WriteLine "Date (dd-mmm-yyyy)                     :" & ToDate
        ResutlsStream.WriteLine ""
        ResutlsStream.Close

        If (Len(Dir(TrainingFolder, vbDirectory)) = 0) Then
        MkDir TrainingFolder
        End If

        If (Len(Dir(TrainingFolder & "\" & UserName, vbDirectory)) = 0) Then
        MkDir TrainingFolder & "\" & UserName
        End If

        TrainingFile = TrainingFolder & "\" & UserName & "\" & PCPver & ".csv"
        If (Len(Dir(TrainingFile)) = 0) Then
            Set TrainingStream = TrainingFSO.CreateTextFile(TrainingFile, True)
            TrainingStream.WriteLine UserName & "'s " & ModuleName & " " & PCPver & " Training File"
            TrainingStream.WriteLine "===================================================================================================="
            TrainingStream.WriteLine "Operator" & Chr(44) & "PCP Version" & Chr(44) & "W/O" & Chr(44) & "Serial" & Chr(44) & "Date" & Chr(44) & "Time"
            TrainingStream.WriteLine "===================================================================================================="
        Else
            Set TrainingStream = TrainingFSO.OpenTextFile(TrainingFile, 8)
        End If
        TrainingStream.WriteLine UserName & Chr(44) & PCPver & Chr(44) & WorkOrder & Chr(44) & Serial & Chr(44) & ToDate & Chr(44) & Format(time, "HH:MM:SS AM/PM")
        TempReportFile = ReportFile
    End If
    'Detect Slide Number and Retrive Relevant Question from INI File
    y = SSW.View.CurrentShowPosition
    If (Len(y) > 0) Then
        xType = GetINIString(SSW.View.CurrentShowPosition, "PromptType", INIPath)
        If (Len(xType) > 0) Then
            Set ResutlsStream = ResutlsFSO.OpenTextFile(TempReportFile, 8)
            Select Case xType
                Case "Message"
                    xPrompt = GetINIString(SSW.View.CurrentShowPosition, "Prompt", INIPath)
                    MsgBox xPrompt, vbYes, xPrompt
                Case "Date"
                    xPrompt = GetINIString(SSW.View.CurrentShowPosition, "Prompt", INIPath)
                    Do
                        msgResult = 7
                        Do
                            inputvar = InputBox(xPrompt, "Enter Date")
                            InputvarDate = inputvar
                            msgResult = MsgBox("You have Enterd " & Format(inputvar, "dd-Mmm-yyyy") & " to " & xPrompt, vbYesNo + vbDefaultButton2, "Check Date Input")
                            If (StrPtr(inputvar) = 0) Or (Len(inputvar) < 6) Then
                                MsgBox "Invalid Date Input - Cannot be Empty / Null / cancelled. Enter a Valid date, in dd-Mmm-yyyy format", 16, "Invalid Input."
                            End If
                            inputvar = Format(inputvar, "dd-Mmm-yyyy")
                            If (Not IsDate(inputvar)) Then
                                MsgBox "Enter a Valid date, in dd-Mmm-yyyy format", 16, "Invalid Date."
                            End If
                        Loop Until (IsDate(inputvar) = True) And (msgResult = vbYes) And (Len(InputvarDate) > 6)
                    Loop Until (IsDate(inputvar) = True) And (msgResult = vbYes)
                    ResutlsStream.WriteLine "Step " & SSW.View.CurrentShowPosition & ". " & xPrompt & Chr(9) & ":" & Chr(9) & inputvar & " " & xvarUnit
                Case "TrueFalse"
                    xPrompt = GetINIString(SSW.View.CurrentShowPosition, "Prompt", INIPath)
                    Do
                        msgResult = 7
                        Do
                            inputvar = InputBox(xPrompt, "Enter True or False")
                            msgResult = MsgBox("You have Enterd " & inputvar & " to " & xPrompt, vbYesNo + vbDefaultButton2, "Check Your Input (True/False)")
                            If (StrPtr(inputvar) = 0) Or (Len(inputvar) < 0) Then
                                MsgBox "Invalid Input - Cannot be Empty / Null / cancelled", 16, "Invalid Input."
                            End If
                            If (inputvar <> "True") And (inputvar <> "False") Then
                                MsgBox "Invalid Input - Enter Either True or False", 16, "Invalid Input."
                            End If
                        Loop Until (Len(inputvar) > 0) And (inputvar = "True") Or (inputvar = "False") And (msgResult = vbYes)
                    Loop Until (Len(inputvar) > 0) And (inputvar = "True") Or (inputvar = "False") And (msgResult = vbYes)
                    If inputvar = True Then
                        ResutlsStream.WriteLine "Step " & SSW.View.CurrentShowPosition & ". " & xPrompt & Chr(9) & ":" & Chr(9) & inputvar
                    Else
                        MsgBox "Test criteria failed, contact production engineer."
                        ResutlsStream.WriteLine "Step " & SSW.View.CurrentShowPosition & ". " & xPrompt & Chr(9) & ":" & Chr(9) & inputvar & " " & xvarUnit & " Failed" & " ***NCR Required***"
                    End If
                Case "General"
                    xPrompt = GetINIString(SSW.View.CurrentShowPosition, "Prompt", INIPath)
                    Do
                        msgResult = 7
                        Do
                            inputvar = InputBox(xPrompt, xPrompt)
                            msgResult = MsgBox("You have Enterd " & inputvar & " to " & xPrompt, vbYesNo + vbDefaultButton2, "Check Input")
                            If (StrPtr(inputvar) = 0) Or (Len(inputvar) < 0) Then
                                MsgBox "Invalid Input - Cannot be Empty / Null / cancelled", 16, "Invalid Input."
                            End If
                        Loop Until (Len(inputvar) > 0) And (msgResult = vbYes)
                    Loop Until (Len(inputvar) > 0) And (msgResult = vbYes)
                    ResutlsStream.WriteLine "Step " & SSW.View.CurrentShowPosition & ". " & xPrompt & Chr(9) & ":" & Chr(9) & inputvar & " " & xvarUnit
                Case "Limit"
                    xLimitHi = GetINIString(SSW.View.CurrentShowPosition, "LimitHi", INIPath)
                    xLimitLo = GetINIString(SSW.View.CurrentShowPosition, "LimitLo", INIPath)
                    xPrompt = GetINIString(SSW.View.CurrentShowPosition, "Prompt", INIPath)
                    xvarUnit = GetINIString(SSW.View.CurrentShowPosition, "varUnit", INIPath)
                    If GetTestCriteria(xPrompt, xLimitLo, xLimitHi, xvarUnit, result) Then
                        ResutlsStream.WriteLine "Step " & SSW.View.CurrentShowPosition & ". " & xPrompt & Chr(9) & ":" & Chr(9) & result & " " & xvarUnit
                    Else
                        MsgBox "Test criteria failed, contact production engineer."
                        Do
                            msgResult = 7
                            Do
                                FailedResult = InputBox("Enter Values Failed in " & xPrompt, "Enter Failed Value")
                                msgResult = MsgBox("You have Enterd Failed Value of " & FailedResult, vbYesNo + vbDefaultButton2, "Check Failed Input")
                                If (StrPtr(FailedResult) = 0) Or (Len(FailedResult) = 0) Then
                                    MsgBox "Invalid Input - Cannot be Empty / Null / cancelled", 16, "Invalid Input."
                                End If
                            Loop Until (Len(FailedResult) > 0) And (msgResult = vbYes)
                        Loop Until (Len(FailedResult) > 0) And (msgResult = vbYes)
                        ResutlsStream.WriteLine "Step " & SSW.View.CurrentShowPosition & ". " & xPrompt & Chr(9) & ":" & Chr(9) & FailedResult & " " & xvarUnit & " Failed" & " ***NCR Required***"
                    End If
                    ResutlsStream.Close
            End Select
        End If
    End If
    If (Timed = "ON") Then
        If (Len(Dir(TimeingFolder, vbDirectory)) = 0) Then
            MkDir TimeingFolder
        End If
        If (Len(Dir(TimeingFolder & "\" & PCPver, vbDirectory)) = 0) Then
            MkDir TimeingFolder & "\" & PCPver
        End If
        TimingFile = TimeingFolder & "\" & PCPver & "\" & "Timing-" & WorkOrder & "-" & Serial & "-" & PCPver & "-" & ToDate & ".csv"
        If (Len(Dir(TimingFile)) = 0) Then
            Set TimeingStream = TimeingFSO.CreateTextFile(TimingFile, True)
            TimeingStream.WriteLine UserName & "'s " & ModuleName & " " & PCPver & " Build Time File"
            TimeingStream.WriteLine "===================================================================================================="
            TimeingStream.WriteLine "Seq/Step" & Chr(44) & "Start Time" & Chr(44) & "End Time"
        Else
            Set TimeingStream = TimeingFSO.OpenTextFile(TimingFile, 8)
        End If
        EndTime = Format(time, "hh:mm:ss")
        TimeingStream.WriteLine "No:" & SSW.View.CurrentShowPosition & Chr(44) & StartTime & Chr(44) & EndTime
        TimeingStream.Close
    End If
End Sub
Private Function ConfirmUserInput(ByVal inputvar As Double) As Boolean
    ConfirmUserInput = MsgBox("Confirm value: " & CStr(inputvar) & "?", vbYesNo + vbDefaultButton2, "Confirm value") = vbYes
End Function
Private Function IsValidUserInput(ByVal userInput As String, ByVal xLimitLo As Double, ByVal xLimitHi As Double, ByRef outResult As Double) As Boolean

    Dim result As Boolean
    Dim numericInput As Double

    If StrPtr(userInput) = 0 Then
    MsgBox "Invalid Input - Entry cannot be cancelled", 16, "Invalid User Input"
    ElseIf userInput = vbNullString Then
        MsgBox "Invalid Input - Entry cannot be Empty / Null", 16, "Invalid User Input"
    ElseIf Not IsNumeric(userInput) Then
        MsgBox "Invalid Input - Numeric Input required", 16, "Invalid User Input"
    Else
        numericInput = CDbl(userInput)
        If numericInput < xLimitLo Or numericInput > xLimitHi Then
            MsgBox "Invalid Input - Not within Limits", 16, "Invalid User Input"
        Else
            result = ConfirmUserInput(numericInput)
            outResult = numericInput
        End If
    End If

    IsValidUserInput = result

End Function
Private Function GetTestCriteria(ByVal xPrompt As String, ByVal xLimitLo As Double, ByVal xLimitHi As Double, ByVal xvarUnit As String, ByRef outResult As Double) As Boolean

    Const failed As String = "Failed"

    Dim prompt As String
    prompt = "Enter Value between " & xLimitLo & xvarUnit & " and " & xLimitHi & xvarUnit & "(Inclusive)"

    Dim userInput As String
    Dim isValid As Boolean

    Do

        userInput = InputBox(prompt, xPrompt)
        isValid = IsValidUserInput(userInput, xLimitLo, xLimitHi, outResult) Or userInput = failed

    Loop Until isValid

    GetTestCriteria = (userInput <> failed)

End Function

Private Sub TextBox1_Change()

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

End Sub

> 模块中的代码

Option Explicit
Option Compare Text
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Const CONFIG_FILE = "Config.ini"
Public Function GetINIString(ByVal sApp As String, ByVal sKey As String, ByVal filepath As String) As String
    Dim sBuf As String * 256
    Dim lBuf As Long
    lBuf = GetPrivateProfileString(sApp, sKey, "", sBuf, Len(sBuf), filepath)
    GetINIString = Left$(sBuf, lBuf)
End Function
Public Function WriteINI(ByVal sApp As String, ByVal sKey As String, ByVal sValue As String) As String
    WritePrivateProfileString sApp, sKey, sValue, "Config.ini"
End Function

Config.ini 中的代码 Config.ini 与 .ppsm 文件位于同一文件夹中

[PCPInfo]
;This will force the operator to check PCP version against BOM
;This is required as it is used to tie in the check list to the PCP
PCPver=12.3456.789.A01

;this is used as the heading for creating results files
ModuleName=NEW Validation Test Case

;this to check the correct PCP Power-point file is present with the ini file - if this is incorrect power point will not run
PCPFileName=12.3456.789.A01 NEW Validation Test Case.ppsm

[Options]
;Switch ON/OFF to collect timing data
Timed=ON

[Folders]
;If required creates last folder of the path 
;folder where all check-lists/result files collected
ResultsFolder=C:\Reports\Validation

;folder where all training data collected
TrainingFolder=C:\Training Records

;folder where all timing data collected
TimeingFolder=C:\Times

;Check Who has completed training here - Not implemented
TrainedFolder=C:\TrainedOP

;Do not Use Slide No 1 - Use slide number in square brackets [x]
;First Slide collects Work Order, User name , Serial Number information
;PromptTypes Message,Date,TrueFalse,General,Limit *compulsory
;Type Message Displays Pop up message only , No Data Collection
;Type Date accepts dates in DD-MMM-YYYY format
;Type TrueFalse can be used for Passed failed, checks etc.
;Type General can be used for Part Serial numbers, batch dates
;Type Limit can be used for test parameters with a range,- 
;   - if not within the range "Failed" can be used to complete the step and return to a previous step
;       LimitHi refers to Higher limit should be less than or equal to *compulsory for type Limit
;       LimitLo Refers to Lower limit should be Greater than or equal to *compulsory for type Limit
;Prompt will pop-up the user input box wit the text as question/criteria *compulsory
;VarUnit Type of Unit Ohms,Psi,kPa etc.

[2] 
PromptType=Message
LimitHi=
LimitLo=
Prompt=Revision Record
varUnit=

[4] 
PromptType=Date
LimitHi=
LimitLo=
Prompt=Enter to days Date
varUnit=

[6] 
PromptType=TrueFalse
LimitHi=
LimitLo=
Prompt=Enter True or False
varUnit=

[8]
PromptType=General
LimitHi=
LimitLo=
Prompt=Enter Any text
varUnit=

[10]
PromptType=Limit
LimitHi=200
LimitLo=100
Prompt=Enter Value within limits
varUnit=Bar

再次感谢@retailcoder 最好的祝福 Dumidu Roshan 又名 rellik - @rellik