Excel的VBA - 环
问题描述：
你好老乡StackOverflow的用户在自动化错误，Excel的VBA - 环
所以我的问题是与大量使用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
尽我所能使它全部可读，抱歉，如果它有点混乱。我认为我已经缩小了保护/取消保护循环中的工作表的问题，因为即使当我注释掉其他循环以添加/删除名称时，仍会导致自动化错误，然后Excel崩溃。我还应该提到，每张表格只有一个可编辑/不受保护的选择单元格，以避免不必要的编辑和格式更改，这就是为什么我需要在添加/删除名称或更改单元格值之前取消保护。
任何帮助，这将不胜感激，甚至评论，如果你觉得我可以做得更好。
谢谢！
答
我记得有这个错误，这是与我是如何保护片，我用了一个完成的事 -
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
保护
答
OK - 我认为...问题解决或找到了，或两者兼而有之。虽然上面的答案确实有助于感谢你。
似乎问题归结于可能在worksheet_activate和worksheet_change函数中存在代码，这可能在遍历表单时导致一些连续循环。在上面的函数被调用之前，只需使用Application.EnableEvents = False就可以解决这个问题，因为我不打算在循环遍历这些表单时运行任何其他函数/子集。
会给出一个尝试谢谢:)虽然将需要设置的大部分值保护到错误heh。 –
经过一些测试后，似乎通过修改循环来达到这个目的：'对于ActiveWorkbook.Worksheets中的每个ws'，所以不知道它是否不喜欢变量上的循环或弄糊涂。我还添加了你的建议，检查工作表是否受到'If ws.ProtectContents = True'的保护，并添加了一些调试，以便让我知道它何时成功。它仍然似乎命中而错过，因为在循环过程中有时仍然会出现同样的错误，并且当我尝试修改循环中的每个工作表时，总会这样做。 'ws.Range（“C12”）。Value =“？”'导致Excel崩溃。 –
不好意思听到男人，应该ws.Range（“C12”）。Value =“？”不是ws.Range（“C12”）。Value =“”？“”，将通配符更改为一个字符？ – Lowpar