在运行时使用VBcomponents块在执行时自动将变量插入InputBox和/或在运行时进行代码操作

Question

我有一个两层的问题。 我最初发布了第一部分，但是由于误解，它被标记为重复。 到目前为止，我在这里发布了我的整个步骤：

我有许多测验要评分，每个测验都会生成一个inputBox来搜索给定范围内的产品代码字符串。 是否可以将已知字符串从该范围内的单元格（由MY CODE调用THEIR子程序定义）传递到inputBox并按预期继续。 特别是，我对不必停止每个inputBox来输入某些字符串而尽可能自动地进行评分感兴趣。 我假设可能会出现一个用于inputBox的事件处理程序，但尚未在任何地方找到它。 此外，除了SendKeys方法之外，我还没有找到一种将字符串“键入”到inputBox的好方法。 谢谢。

我不知道我要做什么。 我有如下代码：

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

我在每个学生的工作簿上都有一个文件夹，我计划遍历所有学生的工作簿，并对它们的黑盒测试名为“ 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

如您所见，我包括了inputBox modifyCode() ，用一个值替换了学生代码中的inputBox调用。 这段代码很好，但是由于某种原因我无法解决另一个问题。 在最初发布的初始代码中，这允许在学生称为的宏中检测到错误，因为错误处理无法通过ACROSS工作簿进行。 这样做很完美，因为“编辑并继续”功能运行良好（即，如果学生代码中的语法错误，执行将停止，我可以找到他们的错误，并适当扣除分数）。 但是，使用modifyCode()并执行学生的宏会以某种方式锁定此便捷功能。 它引发了Can't edit module错误，但是我找不到确切的信息源（确切的原因是使用SourceSafe时，我没有）。 相反，我将测试分为“更改代码”执行和“运行宏”执行。 这是有效的，但是如最初所述，它必然会更改学生的代码。 请尝试给我任何见识。 谢谢。

Answer 1

如果只想在InputBox中放置一个Default值，请检查Application.InputBox方法（Excel） 。