我有两个问题。我最初发布了第一部分，但它被标记为重复，因为我认为是一个误解。到目前为止，我发布了我的整个步骤：
我有许多测验要评分，每个测验都生成一个inputBox来搜索给定范围内的产品代码字符串。是否可以从此范围内的单元格（由调用THEIR sub的MY CODE定义）传递已知字符串到inputBox并按预期继续。特别是，我有兴趣尽可能地自动进行评分，而不必停止每个inputBox输入一些字符串。我假设可能有inputBox出现的事件处理程序，但无法在任何地方找到它。另外，我还没有找到一种很好的方法将我的字符串“键入”除inputBox方法之外的SendKeys。感谢。
我不知道我是否清楚自己要做什么。我的代码如下：
Sub BlackBoxTestingPart1()
Dim myXLS As Excel.Workbook, quizNum As String, file As String
Dim ws As Worksheet, compileWs As Worksheet, wb As Workbook
Dim j As Integer, correct As Boolean,
Dim counter As Integer, pathstring As String
Dim i As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
'get root directory and filename for first student
quizNum = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, " ") - 1)
Set compileWs = ActiveWorkbook.Sheets("Compiled")
pathstring = ThisWorkbook.Path & "\" & quizNum & " Submissions\"
file = Dir(pathstring)
On Error GoTo nextStudent
i = 1
Do While file <> ""
'continue do loop if file is data file
If file = "OtherProducts.xlsm" Or file = "OtherProducts.xlsx" _
Or file = "Quiz8.xlsm" Or file = "Quiz8.xlsx" Or file = "oprodcuts.xlsx" _
Or file = "Quiz08.xlsx" Or file = "Quiz08.xlsm" Or file = "OtherProducts_Quiz8_Conley.xlsx" Then GoTo NextLoop
Set myXLS = Workbooks.Open(pathstring & file, 0)
Set ws = myXLS.Sheets("Example 9.1")
counter = 0
'PART1
j = 1
'RUN STUDENT MACRO FROM THEIR WORKBOOK; THIS IS WHERE THE INPUT BOX IS OF INTEREST
Application.Run ("'" & myXLS.Name & "'!FindPriceFromOtherFile")
If MsgBox("Correct?", vbYesNo) = vbYes Then counter = counter + 1
Start1:
j = 2
Application.Run ("'" & myXLS.Name & "'!FindPriceFromOther")
If MsgBox("Correct?", vbYesNo) = vbYes Then counter = counter + 1
Start2:
'close their file
myXLS.Close False
Set myXLS = Nothing
Set ws = Nothing
[d1].Offset(i, 0) = counter
'see if student did not close datafile
For Each wb In Workbooks
If wb.Name <> "Quiz08 Compilation.xlsm" Then
[e1].Offset(i, 0) = 0
wb.Close
Exit For
Else
[e1].Offset(i, 0) = 1
End If
Next
i = i + 1
NextLoop:
file = Dir()
Loop
Set compileWs = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Exit Sub
nextStudent:
If j = 1 Then
Resume Start1
ElseIf j = 2 Then
Resume Start2
End If
End Sub
我有一个包含每个学生工作簿的文件夹，我计划迭代所有这些工作簿，并且blackbox测试他们的宏名为“FindPriceFromOther”（或“FindPriceFromOtherField”，对于那些不能简单地遵循命名协议的学生）。这是他们代码的纯粹原型版本：
Public Sub FindPriceFromOther()
Dim thisPath As String
thisPath = ActiveWorkbook.Path
Workbooks.Open (thisPath & "\otherproducts.xlsx")
'All old code below
Dim code() As String, price() As Currency
Dim size As Integer
Range("A4", Range("A4").End(xlDown)).Name = "Products"
Range("B4", Range("B4").End(xlDown)).Name = "Prices"
size = Range("Products").Rows.Count
ReDim code(size)
ReDim price(size)
Dim i As Integer
For i = 1 To size
code(i) = Range("Products").Cells(i)
price(i) = Range("Prices").Cells(i)
Next
Workbooks("otherproducts.xlsx").Close 'ADDED
Dim thiscode As String, thisPrice As Double
thiscode = InputBox("Enter Code", "Capture Code")
For i = 1 To size
If thiscode = code(i) Then Exit For
Next i
thisPrice = price(i)
'already given
'Dim thiscode As String, thisPrice As Double
MsgBox "The unit price of product code " & thiscode & " is " & _
Format(thisPrice, "$0.00"), vbInformation, "Product found"
End Sub
所以你可以看到他们的宏打开一个数据工作簿，将两个范围复制到两个数组，然后是inputBox;我很好奇是否有任何方法可以将其中一个产品代码（也许我可以在inputBox触发之前以某种方式在运行时声明）进入inputBox。希望这能使我想要的更清楚。
编辑：我终于开始使用某种代码，如下所示：
我最终做了我想做的事情，但需要改变我学生的提交代码。在我看来，这似乎是一种非常非常愚蠢的方式来做我想做的事。
Public Sub BlackBoxTestingPart2()
Dim myXLS As Excel.Workbook, quizNum As String, file As String
Dim ws As Excel.Worksheet, compileWs As Excel.Worksheet
Dim j As Integer, correct As Boolean, counter As Integer, pathstring As String
Dim i As Integer, wb As Workbook, procedureType As Integer
Dim closedFile As Boolean
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
procedureType = InputBox("1 for changing code, 2 for running macros", "Type of Execution")
quizNum = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, " ") - 1)
Set compileWs = ActiveWorkbook.Sheets("Compiled")
pathstring = ThisWorkbook.Path & "\" & quizNum & " Submissions\"
file = Dir(pathstring)
On Error GoTo nextStudent
i = 1
Do While file <> ""
If Not file Like "*######*" And Not file Like "*#####*" _
And Not file Like "*####*" Then GoTo NextLoop
Set myXLS = Workbooks.Open(pathstring & file, 0)
Set ws = myXLS.Sheets("Example 9.1")
If procedureType = 1 Then
j = 0
Call modifyCode(myXLS)
Start0:
myXLS.Close True
Set myXLS = Nothing
Set ws = Nothing
ElseIf procedureType = 2 Then
counter = 0
'PART1
j = 1
Application.Run "'" & myXLS.Name & "'!FindPriceFromOtherFile"
'Application.Run myXLS.Name & "!FindPriceFromOtherFile"
If MsgBox("Correct?", vbYesNo) = vbYes Then counter = counter + 1
Start1:
j = 2
Application.Run "'" & myXLS.Name & "'!FindPriceFromOther"
'Application.Run myXLS.Name & "!FindPriceFromOther"
If MsgBox("Correct?", vbYesNo) = vbYes Then counter = counter + 1
Start2:
myXLS.Close False
Set myXLS = Nothing
Set ws = Nothing
closedFile = True
For Each wb In Workbooks
If wb.Name <> "Quiz08 Compilation.xlsm" Then
closedFile = False
wb.Close
Exit For
End If
Next
Set wb = Nothing
[d1].Offset(i, 0) = counter
If Not closedFile Then
[e1].Offset(i, 0) = 0
Else
[e1].Offset(i, 0) = 1
End If
i = i + 1
End If
NextLoop:
file = Dir()
Loop
Set compileWs = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Exit Sub
nextStudent:
If j = 1 Then
Resume Start1
ElseIf j = 2 Then
Resume Start2
ElseIf j = 0 Then
Resume Start0
End If
End Sub
Sub modifyCode(wb As Workbook)
Dim newCode As String, varName As String, j As Integer
Dim cmpComponent As VBIDE.VBComponent
newCode = " = ""L2201-2"""
For Each cmpComponent In wb.VBProject.VBComponents
If cmpComponent.Type = vbext_ct_StdModule Then
For j = 1 To cmpComponent.CodeModule.CountOfLines
If cmpComponent.CodeModule.Lines(j, 1) Like "* [=]*InputBox*" Then
varName = Left(cmpComponent.CodeModule.Lines(j, 1), InStr(cmpComponent.CodeModule.Lines(j, 1), "=") - 1)
cmpComponent.CodeModule.ReplaceLine j, varName & newCode
End If
Next j
End If
Next cmpComponent
Set cmpComponent = Nothing
End Sub
因为您可以看到我添加了modifyCode()来替换学生代码中的inputBox调用只是一个值。这段代码没问题，但出于某种原因，我无法解决另一个问题。在首次发布的初始代码中，这允许在学生的被调用的宏中检测到错误，因为错误处理不能进入ACROSS工作簿;这是完美的，因为编辑并继续功能工作正常（即如果学生代码中的语法错误，执行将停止，我可以找到他们的错误，并适当地扣除积分）。但是，使用modifyCode()并执行学生的宏以某种方式锁定了这个方便的功能。它引发了Can't edit module错误，但是我找不到关于为什么会发生这种情况的良好信息来源（唯一的信息是使用SourceSafe时，我不是）。相反，我将测试分为“更改代码”执行和“运行宏”执行。这有效，但如最初所述，它必然会改变学生的代码。
请尝试给我任何见解。感谢。