VBA DO Loops Issue

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, чтобы вернуть inpu t - но эта функция уже возвращает Boolean.Одним из решений может быть использование «вне» параметр:

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, и существующие вопросы о переполнении стека не имеют для вас ответа (немного маловероятно), не стесняйтесь задавать другой вопрос!

Answer 2

Ответ розничного торговца как общий подход является верхней меткой. Я хотел бы обратить особое внимание на использование IsNumeric(), которое позволило бы решить большинство проблем. В настоящее время ваш код выходит из строя, если введена какая-либо нечисловая строка.

Посмотрите на код, чтобы попытаться посмотреть, смогу ли я хотя бы ответить на то, что происходит, чтобы попытаться успокоить ваше любопытство. Вы упомянули, что похоже, что вы не могли оставить свой второй цикл. На практике мне не удалось выйти из первого цикла. Я уверен, был связан с StrPtr(InputvarTemp) = 1. Я даже не знал, что это такое, пока я не посмотрел. Короче говоря, это недокументированная функция, которая была использована для проверки того, был ли нажат/получить адрес базы данных переменных (по-видимому).

До конца первой петли я положил это в для отладки

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

Когда я типа «150» в InputBox результатов окна сообщений являются следующими. Третье значение представляет StrPtr(InputvarTemp)

3 6 246501864 FALSE 

246501864 больше 1, которое может вызвать выход петли на провал. Опять же, розничный кодер имеет отличный ответ, и я не буду изобретать его колесо.

Answer 3

с благодарностью @retailcoder и ниже @ Matt является законченным кодом для любого использования, ваша помощь действительно присвоила

Захвата пользовательского ввода в файл (ы) из Powerpoint презентации, используя config.ini, чтобы свести к минимуму повседневного программирования (или не программного кода для обычного пользователя)

> кода в слайде 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 aka rellik - @rellik