Excel VBA-循环期间发生自动化错误 [英] Excel VBA - Automation Error during loop

问题描述

您好，还有StackOverflow用户，

Hello there fellow StackOverflow users,

所以我的问题是一个工作簿，该工作簿大量使用VBA来自动化和计算多个函数.但是，特别是我写的一个函数，当更新主副本时，该函数会更新工作簿的代码和命名范围，只需通过单元格检查中的版本号即可完成.

So my issue is with a workbook that heavily uses VBA to automate and calculate several functions. However the one in particular is a function I wrote that updates the code and named ranges of the workbook when the master copy is updated, which is done simply by a version number in a cell check.

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循环中的工作表有关的问题，因为即使我注释掉其他循环来添加/删除名称时，它仍然会导致自动化错误然后Excel崩溃.我还应该提到，每个工作表都只有一个可编辑/不受保护的选定单元格，以尝试避免不必要的编辑和格式更改，这就是为什么我需要在添加/删除名称或更改单元格值之前取消保护.

Did my best to make it all readable, and sorry if its a bit messy. I think I have narrowed down the problem to do with protecting/unprotecting the sheets within the For Each ws in currWB.Worksheets loop as when even when I comment out the other loops for adding/removing names it still causes an Automation Error and then Excel crashes. I should also mention that every sheet only has a select cells that are editable/unprotected to try and avoid unwanted editing and format changing, which is why I need to unprotect before adding/removing names or changing cell values it seems.

在此方面的任何帮助将不胜感激，如果您觉得我可以做得更好，甚至可以发表评论.

Any help on this would be appreciated, or even comments if you feel I could do this any better.

谢谢！

推荐答案

确定-我认为...问题已解决或发现，或两者兼而有之.尽管上面的答案确实对您有所帮助.

OK - I think...problem solved or found or both. Although the answer above did help thank you.

似乎问题归结于可能在worksheet_activate和worksheet_change函数中包含代码，这些代码很可能在遍历工作表时引起一些连续循环.只需在调用上面的Function之前使用Application.EnableEvents = False即可解决此问题，因为在遍历此类工作表时，我不希望运行任何其他功能/子.

Seems the problem was down to possibly having code in the worksheet_activate and worksheet_change function, which may well have caused some continuous loop when iterating through the sheets. This was resolved simply by using Application.EnableEvents = False before the Function above is called as I don't intend any other functions/subs to be run when looping through sheets like this.

这篇关于Excel VBA-循环期间发生自动化错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！