VBA通过工作表的不需要的循环

我已经使用了这个网站，但是这是我发布的第一个问题，希望我能给出足够的细节。 我无法find任何相关的答案，因为不pipe我search什么，我都会得到与循环代码有关的各种答案。

一些背景：我devise了一个Excel文档来跟踪我工作场所的一些项目（以下简称为“主文档”）。 由于以前的跟踪器允许用户随时编辑任何内容，因此我使用了表单来确保所有信息都能正确input并存储。 对于主文档中的每个项目，都有一个单独的Excel工作簿（以下简称项目文档）。

主文档中有许多表单，它们每次被激活时都会运行代码（因为它们需要更新）。

由于每个项目文档中都有一些VBA代码，这些代码对于与主文档同步数据至关重要，所以我添加了一个警告工作表，该项目文档在没有macros的情况下打开时显示。 这涉及在保存事件之前和保存事件之后使用打开的工作簿，以确保只显示没有macros的警告。 下面是每个事件的代码（显然，放在ThisWorkbook Module中）

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Auto_Open 'This is for sync (Master Document checks for text file to see if any changes have been made to Item Document) If booChange = True Then Dim oFile As Object Set oFile = fso.CreateTextFile(strTextFile) SetAttr strTextFile, vbHidden booChange = False End If 'Turn off Screen Updating Application.ScreenUpdating = False 'Show warning sheet Sheets("Warning").Visible = xlSheetVisible 'Hide all sheets but Warning sheet For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "Warning" Then sh.Visible = xlVeryHidden Next sh End Sub Private Sub Workbook_AfterSave(ByVal Success As Boolean) 'Show all sheets For Each sh In ThisWorkbook.Worksheets sh.Visible = xlSheetVisible Next sh 'Hide the warning sheet Sheets("Warning").Visible = xlVeryHidden 'Return focus to the main page ThisWorkbook.Worksheets(1).Activate 'Turn on Screen Updating Application.ScreenUpdating = True ThisWorkbook.Saved = True End Sub Private Sub Workbook_Open() 'Turn off Screen Updating Application.ScreenUpdating = False 'Show all sheets For Each sh In ThisWorkbook.Worksheets sh.Visible = xlSheetVisible Next sh 'Hide the warning sheet Sheets("Warning").Visible = xlVeryHidden 'Return focus to the main page ThisWorkbook.Worksheets(1).Activate 'Turn on Screen Updating Application.ScreenUpdating = True ThisWorkbook.Saved = True End Sub 

为了完整起见，这里是Item Item的Module1中的所有代码

 'Declarations 'Strings Public strSourceFolder As String Public strTextFile As String 'Other Public fso As FileSystemObject Public booChange As Boolean Public wsFlow As Worksheet 'Constants Public Const strURNSheetName = "Part 1 Plant Flow Out Summ" Sub Auto_Open() Set fso = CreateObject("Scripting.FileSystemObject") Set wsFlow = ThisWorkbook.Worksheets(strURNSheetName) strSourceFolder = fso.Getfile(ThisWorkbook.FullName).ParentFolder.Path strTextFile = fso.BuildPath(strSourceFolder, ThisWorkbook.Worksheets(strURNSheetName).Range("W2").Value & ".txt") End Sub 

当使用“frmNewEntry”表单在主文档中创build项目时，将检查信息并将其input到主文档中，然后打开模板项目文档并使用新的唯一文件名保存。 然后不受保护，更新新的信息，保护，保存和closures。 然后保存主文档。 代码如下（编辑以省略冗长的格式和数据input）：

表格代码：

 Private Sub btnSave_Click() 'Values on form are verified 'Master Document sheet is unprotected, formatted and data entry occurs 'Clear Userform and close For Each C In frmNewEntry.Controls If TypeOf C Is MSForms.ComboBox Then C.ListIndex = -1 ElseIf TypeOf C Is MSForms.TextBox Then C.Text = "" ElseIf TypeOf C Is MSForms.CheckBox Then C.Value = False End If Next frmNewEntry.Hide 'Create filepaths Create_Filepath 'Some hyperlinks are added and the Master Document worksheet is protected again 'Create Flowout Summary Create_Flowout_Summary 'Update Flowout Summary Update_Flowout_Summary 'Turn on screen updating Application.ScreenUpdating = True 'Update Activity Log Update_Log ("New: " & strNewURN) Debug.Print "Before Save Master" 'Save tracker ThisWorkbook.Save Debug.Print "After Save Master" End Sub 

Module1代码：

 Public Sub Create_Flowout_Summary() 'Create a new flowout summary from the template 'Turn off screen updating Application.ScreenUpdating = False 'Check if workbook is already open If Not Is_Book_Open(strTemplate) Then Application.Workbooks.Open (strTemplatePath) End If Debug.Print "Before SaveAs Create" 'Save as new flowout summary Application.Workbooks(strTemplate).SaveAs fileName:=strFilePath Debug.Print "After SaveAs Create" 'Close Document Information Panel ActiveWorkbook.Application.DisplayDocumentInformationPanel = False 'Doesn't seem to work 'Turn on screen updating Application.ScreenUpdating = True End Sub Public Sub Update_Flowout_Summary() 'Update the flowout summary for current call Dim wsURN As Worksheet Set wsURN = Workbooks(strFileName).Worksheets(strWsURNName) 'Unprotect Flowout Summary worksheet wsURN.Unprotect "Flowout Summary" 'Write values to flowout summary 'Protect Flowout Summary worksheet wsURN.Protect "Flowout Summary", False, True, True, True, True Debug.Print "Before Save Update" 'Save flowout summary Application.Workbooks(strFileName).Save Debug.Print "After Save Update" 'Close Document Information Panel ActiveWorkbook.Application.DisplayDocumentInformationPanel = False 'Turn on screen updating Application.ScreenUpdating = True End Sub 

问题详细信息：当我创build一个新的条目需要很长时间，我意外地发现主文档正在运行代码在每个表激活事件（上面提到）（我有一个神秘的床单诊断msgbox当我创build一个新的条目时出现）我因此得出结论，代码是以某种方式激活每个工作表，但不知道为什么….

任何帮助将不胜感激，如果我错过了任何可能有助于诊断只是让我知道。

编辑：另一个奇怪的现象是，当我尝试通过代码来find激活事件被触发的确切位置时，这不会发生。

编辑：工作表中的代码激活事件

 Private Sub Worksheet_Activate() 'Turn off Screen Updating Application.ScreenUpdating = False 'Simply writes data to the sheet (excluded because it is lengthy) 'Turn on Screen Updating Application.ScreenUpdating = True wsMyCalls.Protect Password:=strPassword Debug.Print "wsMyCalls" MsgBox "This sheet uses your username to display any calls you own." & vbNewLine & _ "It relies on the correct CDSID being entered for owner." & vbNewLine & vbNewLine & _ "Regards" & vbNewLine & _ "Your friendly spreadsheet administrator", vbOKOnly, "Information" End Sub 

编辑：我添加了一些Debug.Prints代码（上面），这就是我得到的。

• SaveAs创build之前
• SaveAs创build后
• 保存更新之前
• 保存更新后
• Save Master之前
• 保存完毕后
• wsMyCalls

这表明代码正在Debug.Print“保存主”后和End Sub之间执行。 那里没有代码？

谢谢

Answer 1

我相信我们在这里看不到你的整个代码。 考虑到我们没有工作簿来debugging自己，所以很难诊断。 不过，我有一个类似的“欢迎”页面，每当我的工作簿打开时都会显示，要求用户激活macros。 我将EnableEvents设置为false，并在保存之前将我的工作表置于特定状态，并在保存后将其放回。

我会告诉你我是怎么做的，因为我有一种感觉，你的问题是关于不禁用EnableEvents是正确的时间。 由于提到的不完整代码，我不确定如何根据您的工作簿function来计时。

该表被称为f_macros。 这是工作表激活事件，阻止进一步的导航：

 Private Sub Worksheet_Activate() ActiveWindow.DisplayHeadings = False ActiveWindow.DisplayWorkbookTabs = False End Sub 

在我的Workbook_BeforeSave中：

我首先logging了DisplayHeadings等的当前状态：

 Dim Displaytabs As Boolean Dim DisplayHeadings As Boolean Dim menu As CommandBar Dim ligne As CommandBarControl Displaytabs = ActiveWindow.DisplayWorkbookTabs DisplayHeadings = ActiveWindow.DisplayHeadings 

然后我重置我的自定义右键单击，closuresEnableEvents和屏幕更新。 我将DisplayWorkbookTabs设置为false，以获得较好的效果。

 Application.ScreenUpdating = False Application.EnableEvents = False Application.CommandBars("Cell").reset ActiveWindow.DisplayWorkbookTabs = False 

然后我运行Cacherdata（HideData，在下面附加的另一个模块中的子）我保存，然后运行子macrosmacro_activees将工作簿恢复为用户的工作顺序。 我重新打开EnableEvents，并将标题恢复到原来的状态：

 m_protection.Cacherdata ThisWorkbook.Save m_protection.macro_activees Application.ScreenUpdating = True Application.enableevents = True ActiveWindow.DisplayWorkbookTabs = Displaytabs ActiveWindow.DisplayHeadings = DisplayHeadings 

我取消普通的保存（重要！），并指出工作簿已保存，使他们可以正常退出，而不会提示保存。

 Cancel = True ThisWorkbook.Saved = True 

在BeforeClose中，它会检查工作簿状态是否已保存。 如果是，就退出。 如果不是，则执行类似的程序：

 If Not (ThisWorkbook.Saved) Then rep = MsgBox(Prompt:="Save changes before exiting?", _ Title:="---", _ Buttons:=vbYesNoCancel) Select Case rep Case vbYes Application.ScreenUpdating = False Application.enableevents = False ActiveWindow.DisplayHeadings = True m_protection.Cacherdata ThisWorkbook.Save Case vbCancel Cancel = True Exit Sub End Select End If 

工作簿打开事件检查它是否是只读模式，但是这一切。 我没有一个工作簿AfterSave。

附件

CacherData使每个工作表非常隐藏，因此用户不会激活数据而不激活macros。 它会logging当前的活动工作表，以便用户返回到原来的位置，解除工作簿的保护，隐藏工作表，保护工作簿，这些都是：

 Sub Cacherdata() Dim ws As Worksheet f_param.Range("page_active") = ActiveSheet.Name f_macros.Activate ThisWorkbook.Unprotect "-----" For Each ws In ThisWorkbook.Worksheets If ws.CodeName <> "f_macros" Then ws.visible = xlSheetVeryHidden Next ThisWorkbook.Protect "-----" Exit Sub End Sub 

macros_activees则相反：

 Sub macro_activees() Dim ws As Worksheet ThisWorkbook.Unprotect "-----" For Each ws In ThisWorkbook.Worksheets ws.visible = xlSheetVisible Next ThisWorkbook.Sheets(f_param.Range("page_active").Value).Activate ThisWorkbook.Unprotect "-----" 'it unportects twice because of the activate event of the worksheet, don't mind that Exit Sub End Sub 

error handling被删除，因为它是无用的显示，但一切都应该在那里。

编辑：如果这根本没有帮助你，也许你的问题是因为你创build的工作簿有他们的代码9我收集），可以影响运行你的代码需要多长时间？ 如果他们自己有Open程序，那可以吗？