VBA DO 루프 문제

Question

지금까지 파워 포인트 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 

누구든지 문제를 지적 할 수 있습니까? 미리 감사드립니다. 이것은 더 큰 코드 프로젝트의 일부이지만이 부분은 작동하지 않습니다.이 코드를 단일 파일로 분리하여 문제를 파악하기 위해 자체적으로 실행할 수 있습니다.

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가 String로 xPrompt을 선언하고, Variant 같은 다른 모든 : 또한 유의하십시오. 나는 그것이 당신의 의도라고 생각하지 않습니다.
• Select Case은 Enum 값과 함께 사용하는 것이 가장 좋습니다. 그렇지 않으면 If-ElseIf 구조를 사용하십시오. 코멘트 아래 당

---

약간의 수정 :

난 당신이 원한다면 이제 파일

에 쓰기 같은 것을 할 수있는 사용자 입력을 캡처 어떻게 유효한 사용자 입력이있는을 수행하십시오 (예 : 파일에 쓰는 경우). inch를 반환하려면 GetTestCriteria이 필요합니다. 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에 의한 것이라고 확신한다. 나는 그것을 찾을 때까지 그게 뭔지조차 몰랐다. 즉, 취소 기능이 변수의 기본 메모리 주소를 푸시/가져 왔는지 확인하는 데 사용 된 기능입니다 (분명히). I는 다음과 같이 메시지 박스의 결과 인에서 InputBox에 "150"을 입력하면

는 제 1 루프의 종료 전에 I는

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

디버깅이 넣어. 세번째 값 StrPtr(InputvarTemp)

3 6 246501864 FALSE 

246,501,864 루프 종료가 실패 할 수있는 것보다 큰 1 나타낸다. 다시 말하지만, retailcoder는 훌륭한 대답을 가지고 있으며, 나는 그의 바퀴를 재발 명하지 않을 것입니다. 및 @ 매트 @retailcoder 덕분에

Answer 3

아래, 당신의 도움이 정말 파워 포인트 프리젠 테이션에서 파일 (들)에 캡처 사용자 입력

를 충당되고, 어떤 사용에 대한 완성 된 코드입니다 config.ini 파일을 사용하여 슬라이드에서 일상적인 프로그래밍 (또는 표준 사용자없이 프로그래밍 코드를)

> 코드를 최소화하기 위해 1

모듈에서 5,

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 

> 코드

config.ini 파일 config.ini 파일에서

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 

코드는 .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 

과 동일한 폴더에 남아있을 수 있습니다

thanks @retailcoder 감사합니다 Dumidu Roshan 일명 rellik - @rellik