Excel VBA-循環期間的自動化錯誤

Question

您好，StackOverflow的其他用戶，

所以我的問題是工作簿中大量使用VBA來自動化和計算幾個函數。 但是，特別是我編寫的一個函數，當更新主副本時，該函數會更新工作簿的代碼和命名范圍，這只需通過單元格檢查中的版本號即可完成。

Function updateCheck(cVer As Double) As Double
Dim currWB As Workbook, isWB As Workbook, iSht As Worksheet, ver As Range, wbName As String, path As String
Dim isCode As CodeModule, wbCode As CodeModule, wbMod As CodeModule, isMod As CodeModule, isNames As New Collection, isVal As New Collection
Dim tmp As Name, nm As Name, ws As Worksheet, tn As Range, verNum As Double, nStr As String, raf As Boolean, tStr As String

path = "Q:\JWILDE\": wbName = "testsheet.xlsm"
Set currWB = ThisWorkbook

With currWB
    .Activate
    Set wbCode = .VBProject.VBComponents("ThisWorkbook").CodeModule
    Set iSht = .Sheets(1)
End With

If Dir(path & wbName) <> "" And Not currWB.path & "\" Like path Then
    Set isWB = Workbooks.Open(path & wbName, ReadOnly:=True)
    isWB.Activate
    verNum = isWB.Names("VerNum").RefersToRange
Else
    updateCheck = cVer
    Exit Function
End If

If cVer < verNum Then
    Debug.Print "...update required, current version: " & verNum
    With isWB
        With .VBProject
            Set isMod = .VBComponents("ISCode").CodeModule
            Set isCode = .VBComponents("ThisWorkbook").CodeModule
        End With

        '--- COMPILES LIST OF NAMES FROM STANDARD SHEET ---
        For Each nm In .Names
            nVal = "=SHT!"
            key = getNRVal(nm.Name, 3)
            nStr = getNRVal(nm.RefersToLocal, 3)
            Debug.Print "Sheet set to: " & getNRVal(nm.Name, 1)
            .Sheets(getNRVal(nm.Name, 1)).Unprotect Password:="jwedit"
            Set tn = .Sheets(getNRVal(nm.Name, 1)).Range(nStr) 'Untested...
            On Error Resume Next
            tStr = isNames(key)
            If tStr <> "" Then
                tStr = ""
            Else
                If nm.Parent.Name = .Name Then
                    Set tn = .Sheets(1).Range(nStr)
                    nVal = "=WB!"
                    isVal.Add tn, key
                    Debug.Print "isVal > " & isVal(key).Name
                End If
                isNames.Add key & nVal & nStr, key
                Debug.Print "...added: " & isNames.Item(key)
            End If
        Next nm
    End With

    If isCode.CountOfLines > 0 And isMod.CountOfLines > 0 Then
        With currWB.VBProject
            Set wbCode = .VBComponents("ISCode").CodeModule
            wbCode.DeleteLines 1, wbCode.CountOfLines
            wbCode.AddFromString isMod.Lines(1, isMod.CountOfLines)

            Set wbCode = .VBComponents("ThisWorkBook").CodeModule
            wbCode.DeleteLines 1, wbCode.CountOfLines
            wbCode.AddFromString isCode.Lines(1, isCode.CountOfLines)
            updateCheck = verNum
        End With
    Else
        Debug.Print "Error. Unable to get updated code."
        updateCheck = cVer
    End If

    isWB.Close SaveChanges:=False
    currWB.Activate

    On Error Resume Next
    Dim wbStr As String: wbStr = isWB.Name

    If wbStr <> "" Then
        Debug.Print "WARNING: " & wbStr & " is still open!"
    Else: Debug.Print "Successfully closed isWB."
    End If

    '--- CHECKS THROUGH EACH SHEET FROM CURRENT WB ---
    For Each ws In currWB.Worksheets
        ws.Unprotect Password:="jwedit"
       '--- CHECK TO REMOVE INVALID OR INCORRECT NAMES ---
        For Each nm In ws.Names
            raf = False
            key = getNRVal(nm.Name, 3) '--> SHEET!NAME > NAME
            nStr = getNRVal(nm.RefersTo, 3) '---> SHEET!REF > REF
            tStr = isNames(key) 'Could change this to: getNRVal(isNames(key),3) to return just REF or nothing.
            Debug.Print "...[" & key & "]..."
            If tStr <> "" Then 'MATCH FOUND...
                Set tn = ws.Range(getNRVal(tStr, 3)) 'Should be the CORRECT RefTo from isNames.
                '--- NAME ON WRONG SHEET ---
                If ws.Index > 1 And getNRVal(tStr, 2) Like "WB" Then
                    Debug.Print " > REMOVE: [" & key & "] does not belong on " & ws.Name
                    nm.Delete
                '--- NAME CORRECT BUT REFTO ISNT ---
                ElseIf Not nStr Like getNRVal(tStr, 3) Then
                    Debug.Print " > INCORRECT: REF (" & nStr & ") of [" & key & "] should be (" & tn.Address & ")."
                    nm.RefersTo = tn
                End If
                tStr = ""
            Else '--- NO MATCH FOUND / INVALID NAME ---
                Debug.Print " > REMOVE: [" & key & "] is invalid."
                raf = True
            End If
            If raf = True Then
                Set tn = ws.Range(nStr)
                tn.ClearContents
                nm.Delete
            End If
        Next nm

       '--- CHECKING FOR NAMES TO ADD ---
        For n = 1 To isNames.Count
            raf = False
            key = getNRVal(isNames(n), 1)   '--> NAME
            nStr = getNRVal(isNames(n), 3)  '--> REF
            nVal = getNRVal(isNames(n), 2)  '--> SHT/WB
            Debug.Print "Looking for [" & key & "] on " & ws.Name

            If ws.Index = 1 And nVal Like "WB" Then
                tStr = currWB.Names(key, RefersTo:=nStr)
                If tStr <> "" Then
                    tStr = ""
                Else: raf = True
                End If
            ElseIf ws.Index > 1 And nVal Like "SHT" Then
                tStr = ws.Names(key, RefersTo:=nStr)
                If tStr <> "" Then
                    tStr = ""
                Else: raf = True
                End If
            End If
            If raf = True Then
                Set tn = ws.Range(nStr)
                ws.Names.Add key, tn
                tStr = isVal(key).Name
                If tStr <> "" Then
                    ws.Names.Add key, tn
                    tn.Value = isVal(key).Value
                End If
                Debug.Print " > ADDED: [" & ws.Names(key).Name & "] with REF [" & ws.Names(key).RefersToLocal & "] on " & ws.Name
            End If
        Next n
        ws.Protect Password:="jwedit", UserInterfaceOnly:=True, AllowFormattingCells:=False
    Next ws

    Debug.Print " --- DONE CHECKING NAMES --- "
    iSht.Activate
    updateCheck = verNum
    isWB.Close SaveChanges:=False
Else
    Debug.Print "No update needed."
    updateCheck = verNum
End If    
End Function

盡我最大的努力使其可讀性好，如果有點混亂，我們深表歉意。 我想我已經縮小了與保護/取消保護For Each ws in currWB.Worksheets循環中的For Each ws in currWB.Worksheets的工作表For Each ws in currWB.Worksheets的問題，即使當我注釋掉其他循環來添加/刪除名稱時，它仍然會導致自動化錯誤 ，然后導致Excel崩潰。 我還應該提到，每個工作表都只有一個可編輯/未受保護的選定單元格，以嘗試避免不必要的編輯和格式更改，這就是為什么我需要在添加/刪除名稱或更改單元格值之前先取消保護。

如果您覺得我可以做得更好，對此將提供任何幫助，甚至發表評論。

謝謝！

Answer 1

我記得有這個錯誤，這與我保護紙張以完成使用的方式有關-

    For Each ws In ActiveWorkbook.Worksheets
        If ws.ProtectContents = True Then
            ws.Unprotect "password"
        End If
    Next ws

和這個

    For Each ws In ActiveWorkbook.Worksheets
        ws.Protect "password", DrawingObjects:=True, Contents:=True, _
                    AllowSorting:=True, AllowFiltering:=True
    Next ws

保護

Answer 2

好的-我認為...問題已解決或已找到，或兩者都有。 盡管以上答案確實對您有所幫助。

似乎問題歸結於可能在worksheet_activate和worksheet_change函數中包含代碼，這些代碼很可能在遍歷工作表時引起一些連續循環。 這可以通過在調用上面的Function之前簡單地使用Application.EnableEvents = False來解決，因為在遍歷這樣的工作表時，我不希望運行任何其他函數/子。