即使在模块中，Excel VBA 宏也不可用，

Question

我做了一些搜索，但没有找到我需要的答案。我正在尝试编写一个使用一系列宏的程序，但它一直给我无法运行宏错误(1004)。在有人问之前，我检查了一下，是的，模块中的宏是并且宏是启用的。由于这些似乎是最常见的原因，我想我现在应该把这些排除在外。

下面是调用宏的代码:

    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 (i.e. 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 (i.e. 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

我不确定是什么导致了这个问题，因为有时它会起作用，有时它不会。几乎在今天之前，宏运行没有问题。我以前见过这个错误，但我之前可以调试它。现在，我似乎无法调试它。

Answer 1

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

    call ParseRows

此外，最好在运行之前激活您希望宏运行的工作表，以防万一。