VBcomponents 블록을 사용하여 실행시 런타임 및/또는 코드 조작시 자동으로 변수를 InputBox에 삽입합니다. 편집시 계속 실행 중입니다.

Question

두 단계로 구성된 질문이 있습니다. 나는 처음에 첫 번째 부분을 게시했지만 오해라고 생각하여 중복 된 것으로 표시되었습니다. 여기까지 지금까지 모든 단계를 게시합니다.

각 범위는 주어진 범위의 제품 코드 문자열을 검색하기 위해 각각 inputBox을 생성하는 등급으로 퀴즈가 있습니다. 이 범위의 셀 (THE 하위를 호출하는 MY CODE로 정의)의 셀에서 알려진 문자열을 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이 발생하면 궁금합니다. 희망이 내가 더 명확하게하고 싶습니다.

편집 :

나는 내가하려고했던 일을 일종의 결국,하지만 내 학생의 submisssions의 코드를 변경하는 데 필요한 : 내가 마지막으로 다음과 같이 코드의 어떤 종류의 시작이 일을 얻었다. 이것은 나에게 내가 원하는 것을하기의 매우, 아주 kludgy 방법 인 것처럼 보인다.

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() 포함되어 있습니다. 이 코드는 괜찮을 지 모르지만 몇 가지 이유로 다른 문제를 해결할 수는 없습니다. 처음 게시 된 초기 코드에서 이것은 오류 처리가 ACROSS 통합 문서로 갈 수 없기 때문에 학생의 매크로라는 오류를 감지 할 수있었습니다. 이것은 편집 및 계속 기능이 잘 작동한다는 점에서 완벽했습니다 (예 : 학생 코드의 구문 오류, 실행이 중단 될 경우 오류를 찾아 적절히 점수를 차감 할 수 있음). 그러나 modifyCode()을 사용하고 학생의 매크로를 실행하면 어떻게 든이 편리한 기능을 잠급니다. 그것은 Can't edit module 오류를 던졌지 만 정확히 왜 이런 일이 일어 났는지에 대한 정보를 얻을 수 없었습니다 (유일한 정보는 SourceSafe를 사용할 때였습니다). 대신 테스트를 "코드 변경"실행과 "매크로 실행"실행으로 나누었습니다. 이것은 효과적 이었지만, 처음에 언급했듯이 반드시 학생들의 코드를 변경합니다. 제게 어떤 통찰력을 주시겠습니까. 감사.

Answer 1

기본값 값을 입력 상자에 넣을 수있게하려면 Application.InputBox Method (Excel)을 확인하십시오.