即使在模块中,Excel VBAmacros也不可用,

我做了一些search,我没有find我需要的答案。 我试图编写一个使用一系列macros的程序,但它一直给我不能运行macros错误(1004)。 在有人问起之前,我检查了一下,是的,模块中的macrosIS和macros都是启用的。 由于这些似乎是最常见的原因,所以我想现在就把那些事情弄明白了。

以下是调用macros的代码:

Sub CreateDeratings() Application.ScreenUpdating = False 'disable screen updating until the whole process is done. Application.Run ("OpenFile") Application.Run ("OpenSheets") Application.Run ("ParseRows") 'This macro won't run Application.Run ("SaveDerating") Application.ScreenUpdating = True 'enable screen updating End Sub And here's what the relevant macro in question looks like: 'Reads the BOM File and sorts each line into worksheets based on part. Sub ParseRows() Dim nmbrOfParts As Integer Dim nmbrOfGlobals As Integer Dim partIndex As Integer Dim cellContent As String Dim nmbrNoRules As Integer Dim fieldOffset As Integer ' Activate the bom sheet and determine number of parts Sheets("BomFile").Activate nmbrOfParts = Cells.CurrentRegion.Rows.Count nmbrOfGlobals = 0 fieldOffset = 1 'Will continue reading data until the end of the line is reached. Then move down to the next line. ' Loop through each row's text string starting at A1 For partIndex = 1 To nmbrOfParts ' Each part can have a different number of fields Dim nmbrOfFields As Integer Dim fieldIndex As Integer Dim row As Integer Dim fieldArray() As String ' Read in the cell's contents cellContent = Range("A" & partIndex).Value 'Check to see if it is a proper row in the BOM and not a header of some kind. If InStr(cellContent, "|") <> 0 Then fieldArray = Split(cellContent, "|") nmbrOfFields = UBound(fieldArray) - 1 fieldArray(0) = Trim(fieldArray(0)) Else GoTo NextLine End If ' Parse the string across fields For fieldIndex = 1 To nmbrOfFields fieldArray(fieldIndex) = Trim(fieldArray(fieldIndex)) 'gets rid of leading or trailing spaces in each element. ' Check if there are any double quotes within an equation, which would indicate a global reference If UBound(Split(fieldArray(fieldIndex), "=")) > 0 Then If UBound(Split(fieldArray(fieldIndex), Chr(34))) > 0 Then ' This is the double quote fieldArray(fieldIndex) = GlobalToValue(fieldArray(fieldIndex)) End If End If 'meant to account for a Bom that lists all the propreties, but not all the components have them. 'EX. A capacitor won't have a resistance, so it will show up blank on the BOM file. 'Check to see if the element under examination does not contain a character. If true, delete it, then proceed. REM If fieldIndex > 5 Then REM If IsEmpty(fieldArray(fieldIndex)) Or Len(Trim(fieldArray(fieldIndex))) = 0 Then REM GoTo REM End If REM End If 'Don't evaluate the line if it does not start with a part number. 'Assumes every line to be evaulated begins with a number. If Not IsNumeric(fieldArray(0)) Then GoTo NextLine End if Select Case fieldArray(0) ' The first element is the Material Group which tells which set of derating rules to apply ' Globals Case "GLOBAL" If fieldIndex = 1 Then row = Sheets("Globals").Cells.CurrentRegion.Rows.Count + 1 nmbrOfGlobals = nmbrOfGlobals + 1 End If Cells(row, 1) = fieldArray(1) Cells(row, 2) = fieldArray(2) REM Sheets("Globals").Cells(row, fieldIndex).Value = fieldArray(fieldIndex) REM Sheets("Globals").Cells(row, fieldIndex).HorizontalAlignment = xlCenter ' Resistors Case 561000, 561100, 561200, 561300, 562000, 561900, 561400, 561500, 561600, 562200, 562100, 561800, 561700, 562300 If fieldIndex = 1 Then row = Sheets("Resistors").Cells.CurrentRegion.Rows.Count + 1 End If 'Attempt to adjust for the P/F fields. REM If fieldIndex = 10 Or fieldIndex = 11 Then REM fieldOffset = fieldOffset + 1 REM End If 'In this block, automatically populate the fields that require set values or formulas. 'Also provides corrections for fields that were misplaced when the file was read due to unforseen bugs. With Sheets("Resistors") 'Place every field in its appropriate place. 'Picks and chooses fields based on the part. 'Assumes the same fields are on every row of the BOM. .Cells(row, 2).Value = fieldArray(2) .Cells(row, 3).Value = fieldArray(1) .Cells(row, 4).Value = fieldArray(3) .Cells(row, 5).Value = fieldArray(4) .Cells(row, 6).Value = fieldArray(5) .Cells(row, 7).Value = fieldArray(9) .Cells(row, 8).Value = fieldArray(10) .Cells(row, 9).Value = "=(H" & row & "/G" & row & ")*100" .Cells(row, 12).Value = fieldArray(13) .Cells(row, 13).Value = fieldArray(14) .Cells(row, 14).Value = "=(M" & row & "/L" & row & ")*100" .Cells(row, 10).Value = 80 .Cells(row, 15).Value = 80 REM .Cells(row, 12).Value = fieldArray(8) REM .Cells(row, 13).Value = fieldArray(9) 'Skip over cells that were automatically populated. Do While Not IsEmpty(.Cells(row, fieldIndex + fieldOffset)) fieldOffset = fieldOffset + 1 Loop REM Call AddPartToSummary(row, fieldArray(1), fieldArray(3), fieldArray(2)) 'Dynamically write a value from the field array to the appropriate cell. REM .Cells(row, fieldIndex + fieldOffset).Value = fieldArray(fieldIndex) REM .Cells(row, fieldIndex + fieldOffset).HorizontalAlignment = xlCenter End With 'Ceramic Capacitors Case 281000, 281500, 281400, 281100, 281300, 281200 If fieldIndex = 1 Then row = Sheets("Ceramic Caps").Cells.CurrentRegion.Rows.Count + 1 End If 'Automatically populate cells, then read remaining values from BOM. With Sheets("Ceramic Caps") 'Place every field in its appropriate place. 'Picks and chooses fields based on the part. 'Assumes the same fields are on every row of the BOM. .Cells(row, 2).Value = fieldArray(2) .Cells(row, 3).Value = fieldArray(1) .Cells(row, 4).Value = fieldArray(3) .Cells(row, 5).Value = fieldArray(4) .Cells(row, 6).Value = fieldArray(6) .Cells(row, 7).Value = fieldArray(9) .Cells(row, 8).Value = fieldArray(10) .Cells(row, 9).Value = "=(H" & row & "/G" & row & ")*100" .Cells(row, 10).Value = 80 REM Call AddPartToSummary(row, fieldArray(1), fieldArray(3), fieldArray(2)) REM .Cells(row, fieldIndex + fieldOffset).Value = fieldArray(fieldIndex) REM .Cells(row, fieldIndex + fieldOffset).HorizontalAlignment = xlCenter End With 'Electrolytic Capacitors Case 281900, 282000 Dim allNumeric As Boolean If fieldIndex = 1 Then row = Sheets("Electrolytic Caps").Cells.CurrentRegion.Rows.Count + 1 End If 'determine the predicted endurance by writing the formula to the cells. 'Might do me well to check to see if it is correct. With Sheets("Electrolytic Caps") '.Cells(row, 18).Formula = "=Q" & row & "*((I" & row & "/J" & row & ")^G" & row & ")*2^((K" & row & "-(L" & row & "+N" & row & "))/10)" 'Place every field in its appropriate place. 'Picks and chooses fields based on the part. 'Assumes the same fields are on every row of the BOM. .Cells(row, 2).Value = fieldArray(2) .Cells(row, 3).Value = fieldArray(1) .Cells(row, 4).Value = fieldArray(3) .Cells(row, 5).Value = fieldArray(4) .Cells(row, 6).Value = fieldArray(6) .Cells(row, 7).Value = fieldArray(7) .Cells(row, 8).Value = fieldArray(8) .Cells(row, 9).Value = fieldArray(9) .Cells(row, 10).Value = fieldArray(10) .Cells(row, 11).Value = fieldArray(15) .Cells(row, 12).Value = fieldArray(16) .Cells(row, 13).Value = fieldArray(22) .Cells(row, 14).Value = fieldArray(23) .Cells(row, 15).Value = fieldArray(17) .Cells(row, 16).Value = fieldArray(18) .Cells(row, 17).Value = fieldArray(24) .Cells(row, 18).Value = fieldArray(25) REM .Cells(row, 14).Value = fieldArray(13) REM .Cells(row, 15).Value = fieldArray(14) REM .Cells(row, 16).Value = fieldArray(15) REM .Cells(row, 17).Value = fieldArray(16) REM .Cells(row, 18).Value = fieldArray(17) 'Skip cells that are full. REM Do While Not IsEmpty(.Cells(row, fieldIndex + fieldOffset)) REM fieldOffset = fieldOffset + 1 REM Loop REM Call AddPartToSummary(row, fieldArray(1), fieldArray(3), fieldArray(2)) 'Read values from the BOM. REM .Cells(row, fieldIndex + fieldOffset).Value = fieldArray(fieldIndex) REM .Cells(row, fieldIndex + fieldOffset).HorizontalAlignment = xlCenter End With 'Film Capacitors Case 282200, 282300 Select Case fieldIndex Case 1 row = Sheets("Film Capacitors").Cells.CurrentRegion.Rows.Count + 1 'Adjust for the P/F Fields. Case 12, 17, 22 fieldOffset = fieldOffset + 1 End Select With Sheets("Film Capacitors") 'Write formulas and values to the cells that need them. .Cells(row, 10).Value = "=(I" & row & "/H" & row & ")*100" .Cells(row, 15).Value = "=(N" & row & "/M" & row & ")*100" .Cells(row, 20).Value = "=(S" & row & "/R" & row & ")*100" .Cells(row, 25).Value = "=(X" & row & "/W" & row & ")*100" .Cells(row, 11).Value = 90 .Cells(row, 16).Value = 80 .Cells(row, 21).Value = 80 .Cells(row, 26).Value = 80 'Place every field in its appropriate place. 'Picks and chooses fields based on the part. 'Assumes the same fields are on every row of the BOM. .Cells(row, 2).Value = fieldArray(2) .Cells(row, 3).Value = fieldArray(1) .Cells(row, 4).Value = fieldArray(3) .Cells(row, 5).Value = fieldArray(4) .Cells(row, 6).Value = fieldArray(6) .Cells(row, 7).Value = fieldArray(21) .Cells(row, 8).Value = fieldArray(9) .Cells(row, 9).Value = fieldArray(10) .Cells(row, 13).Value = fieldArray(11) .Cells(row, 14).Value = fieldArray(12) .Cells(row, 18).Value = fieldArray(15) .Cells(row, 19).Value = fieldArray(16) .Cells(row, 23).Value = fieldArray(19) .Cells(row, 24).Value = fieldArray(20) REM .Cells(row, 13).Value = fieldArray(9) REM .Cells(row, 14).Value = fieldArray(10) REM .Cells(row, 17).Value = Empty REM .Cells(row, 18).Value = fieldArray(11) REM .Cells(row, 19).Value = fieldArray(12) REM .Cells(row, 22).Value = Empty REM .Cells(row, 23).Value = fieldArray(13) REM .Cells(row, 24).Value = fieldArray(14) 'Adjust for full cells REM Do While Not IsEmpty(.Cells(row, fieldIndex + fieldOffset)) REM fieldOffset = fieldOffset + 1 REM Loop REM Call AddPartToSummary(row, fieldArray(1), fieldArray(3), fieldArray(2)) 'Read from the BOM. REM .Cells(row, fieldIndex + fieldOffset).Value = fieldArray(fieldIndex) REM .Cells(row, fieldIndex + fieldOffset).HorizontalAlignment = xlCenter 'Trim uneeded values. REM .Cells(row, 28).Value = Empty REM .Cells(row, 29).Value = Empty End With 'Tantalum Capacitors Case 281600, 281700, 281800 If fieldIndex = 1 Then row = Sheets("Tantalum Caps").Cells.CurrentRegion.Rows.Count + 1 End If 'Automatically populate fields. With Sheets("Tantalum Caps") 'Place every field in its appropriate place. 'Picks and chooses fields based on the part. 'Assumes the same fields are on every row of the BOM. .Cells(row, 2).Value = fieldArray(2) .Cells(row, 3).Value = fieldArray(1) .Cells(row, 4).Value = fieldArray(3) .Cells(row, 5).Value = fieldArray(4) .Cells(row, 6).Value = fieldArray(6) .Cells(row, 7).Value = fieldArray(9) .Cells(row, 8).Value = fieldArray(10) .Cells(row, 9).Value = "=(H" & row & "/G" & row & ")*100" .Cells(row, 10).Value = 80 REM Call AddPartToSummary(row, fieldArray(1), fieldArray(3), fieldArray(2)) 'Read from BOM REM .Cells(row, fieldIndex + fieldOffset).Value = fieldArray(fieldIndex) REM .Cells(row, fieldIndex + fieldOffset).HorizontalAlignment = xlCenter End With 'Niobium Caps Case 282500 If fieldIndex = 1 Then row = Sheets("Niobium Caps").Cells.CurrentRegion.Rows.Count + 1 End If 'Automatically populate fields With Sheets("Niobium Caps") 'Place every field in its appropriate place. 'Picks and chooses fields based on the part. 'Assumes the same fields are on every row of the BOM. .Cells(row, 2).Value = fieldArray(2) .Cells(row, 3).Value = fieldArray(1) .Cells(row, 4).Value = fieldArray(3) .Cells(row, 5).Value = fieldArray(4) .Cells(row, 6).Value = fieldArray(6) .Cells(row, 7).Value = fieldArray(9) .Cells(row, 8).Value = fieldArray(10) .Cells(row, 9).Value = "=(H" & row & "/G" & row & ")*100" .Cells(row, 10).Value = 80 REM Call AddPartToSummary(row, fieldArray(1), fieldArray(3), fieldArray(2)) 'Read from BOM REM .Cells(row, fieldIndex + fieldOffset).Value = fieldArray(fieldIndex) REM .Cells(row, fieldIndex + fieldOffset).HorizontalAlignment = xlCenter End With Case Else 'if it doesn't fit into any other category, put it here. If fieldIndex = 1 Then row = Sheets("NoRules").Cells.CurrentRegion.Rows.Count + 1 nmbrNoRules = nmbrNoRules + 1 End If 'Only read the first few fields. The rest are irrelevant since the part was not recognized. If fieldIndex < 4 Then Cells(row, 2).Value = fieldArray(2) Cells(row, 3).Value = fieldArray(1) End If End Select Next fieldIndex 'Use this label to skip to the next line. NextLine: fieldOffset = 1 'Reset fieldOffset before the next line. Next partIndex 'Process each component type in turn. Only needs to run once because the methods loop through the number of parts. 'Each function requires that its sheet be activated first, or there will be a runtime error. Sheets("Resistors").Activate Application.Run ("Resistors") Sheets("Ceramic Caps").Activate Application.Run ("CeramCap") Sheets("Electrolytic Caps").Activate Application.Run ("ElecCap") Sheets("Film Capacitors").Activate Application.Run ("FilmCapacitors") Sheets("Niobium Caps").Activate Application.Run ("NiobiumCaps") Sheets("Tantalum Caps").Activate Application.Run ("TantaCaps") 'Activate the BOM file sheet at the end so the user can see what was read. Sheets("BomFile").Activate MsgBox ("There were " & (nmbrOfParts - nmbrOfGlobals) & " parts processed with " & nmbrOfGlobals & " included globals." & vbCrLf & "There were " & nmbrNoRules & " part(s) that were placed on the NoRules sheet for not fitting into a Material Group.") End Sub ' The string that has been passed has an "=" sign and at least one pair of double quotes. The equation must be parsed and globals within the quotes ' substituted for the actual global value. This requires that ALL the globals are defined prior to the component parsing. Function GlobalToValue(equation As String) As String Dim globalIndex As Integer Dim returnString As String Dim tbeg As Integer Dim tend As Integer Dim gValue As String nmbrOfGlobals = UBound(Split(equation, Chr(34))) / 2 ' double quotes come in pairs tbeg = InStr(1, equation, Chr(34), vbTextCompare) + 1 ' find first double quote returnString = returnString & Left(equation, (tbeg - 2)) ' copy in the equal sign and any left justified non-global text For globalIndex = 1 To nmbrOfGlobals tend = InStr(tbeg, equation, Chr(34), vbTextCompare) ' find the paired quote If tend < tbeg Then Exit For gValue = ReplaceTextWithValue(Mid(equation, tbeg, tend - tbeg)) ' convert the global reference to a value returnString = returnString & gValue tbeg = tend + 1 ' move to the inter-quote text (ie two globals cannot be back-to-back If tbeg > Len(equation) Then Exit For tend = InStr(tbeg, equation, Chr(34), vbTextCompare) ' move to the end of the inter-quote text If tend < tbeg Then Exit For returnString = returnString & Mid(equation, tbeg, tend - tbeg) ' copy in the inter-quote text tbeg = tend + 1 ' move to the inter-quote text (ie two globals cannot be back-to-back If tbeg > Len(equation) Then Exit For Next globalIndex If tbeg < Len(equation) Then ' if there is non-global text still at the end, copy it in If tbeg > 0 Then returnString = returnString & Right(equation, Len(equation) - InStrRev(equation, Chr(34))) ' find last occurance of double quote End If End If ' MsgBox (returnString) GlobalToValue = returnString End Function ' The text string that is passed is compared against the A column on the Globals sheet and the cell address of the associated value is returned. ' This function could be enhanced with a "not found" feature. Function ReplaceTextWithValue(findString As String) As String Dim nmbrOfGlobals As Integer Dim globalIndex As Integer Dim returnValue As String Dim nowString As String nmbrOfGlobals = Sheets("Globals").Cells.CurrentRegion.Rows.Count findString = Trim(findString) returnValue = "NOTFOUND" For globalIndex = 2 To nmbrOfGlobals nowString = Trim(Sheets("Globals").Cells(globalIndex, 1).Value) If InStr(1, nowString, findString, vbTextCompare) > 0 Then If Len(nowString) = Len(findString) Then ' returnValue = CDbl(Replace(Sheets("Globals").Cells(globalIndex, 2).Value, "=", "")) returnValue = "Globals!$B$" & globalIndex End If End If Next globalIndex ReplaceTextWithValue = returnValue End Function 

我不确定是什么导致了这个问题,因为有时它起作用,有时它不起作用。 在今天之前,这个macros几乎没有任何问题。 我以前看过这个错误,但是我可以在之前debugging它。 现在,我似乎无法debugging它。

你可以尝试调用sub而不是application.run

  call ParseRows 

另外,在运行之前激活要运行macros的工作表是很好的,以防万一。

我有同样的问题,并意识到这是因为包含该过程的模块具有与过程相同的名称。 只是重命名模块,现在在工作簿打开,程序正在运行。