我正试图在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
有人能指出我的问题吗？提前谢谢了。这是一个更大的代码项目的一部分，但这部分不起作用我已将此代码隔离到单个文件中以自行运行以找出问题。
答案 0 :(得分：10)
为了更好地了解正在发生的事情，您需要以尽可能少的方式编写代码;现在你有一个单一的程序可以做很多事情，很难确切地说出出了什么问题以及在哪里。
编写一个函数来确认用户的有效数字输入：
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。一种解决方案可能是使用＆＃34; out＆＃34;参数：
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问题没有给您答案（稍微不太可能），请随时提出另一个问题！
答案 1 :(得分：4)
Retailcoder作为一般方法的答案是顶尖的。我想特别提请注意使用IsNumeric()来解决大多数问题。目前，如果输入任何非数字字符串，您的代码将失败。
看看代码，试着看看我是否能够至少回答正在发生的事情，试图安抚你的好奇心。你提到它看起来你不能离开你的第二个循环。实际上我无法退出你的第一个循环。我确定是StrPtr(InputvarTemp) = 1所致。在我查看之前，我甚至都不知道那是什么。简而言之，它是一个未记录的功能，用于检查是否按下了取消/获取变量的基础内存地址（显然）。
在第一个循环结束之前，我将其放入调试
MsgBox Len(InputvarTemp) & " " & msgResult & " " & StrPtr(InputvarTemp) & " " & IsNull(InputvarTemp)
当我输入＆＃34; 150＆＃34;在InputBox中，消息框的结果如下。第三个值代表StrPtr(InputvarTemp)
3 6 246501864 FALSE
246501864大于1会导致循环退出失败。而零售编码器有一个很好的答案，我不会重新发明他的轮子。
答案 2 :(得分：0)
感谢 @retailcoder 和 @Matt 以下是任何使用的完整代码，您的帮助是真正适当的
使用Config.ini捕获来自Powerpoint演示文稿的文件的用户输入，以最大限度地减少日常编程（或者不向标准用户编写代码）
<强>＆GT;幻灯片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
<强> ＆GT;模块中的代码
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