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

Question

我已经使用过这个网站,但这是我发布的第一个问题,希望我能提供足够的细节.我找不到任何相关的答案,因为无论我搜索什么,我都会得到与循环代码相关的各种答案.

一些背景:我设计了一个excel文档来跟踪我工作场所中的一些项目(以下简称主文档).由于之前的跟踪器允许用户随时编辑任何内容,因此我使用表单来确保正确输入所有信息并安全存储.对于主文档中的每个项目,都有一个单独的Excel工作簿(以下称为项目文档).

主文档中有许多工作表,每次激活时都会运行代码(因为它们需要更新).

As there is some VBA code in every Item Document which is crucial in syncing data with the Master Document, I have added a Warning worksheet which is shown when the Item Document is opened without macros. This involved using the workbook open, before save and after save events to ensure only the Warning is shown without macros. Here is the code for each event (placed in ThisWorkbook Module obviously)

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

And just for completeness, here is all code in Module1 of Item Document

'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

When an item is created in the Master Document using the 'frmNewEntry' form the info is checked and entered into the Master Document then a template Item Document is opened and saved with a new unique filename. It is then unprotected, updated with the new information, protected, saved and closed. The Master Document is then saved. Code follows (edited to omit lengthy formatting and data entry):

Form Code:

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 Code:

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

Problem detail: When I create a new entry it is taking a very long time, I accidentally discovered that the Master Document is running the code in every sheet activate event (mentioned above) (I had a diagnostic msgbox in one of the sheets which mysteriously appeared when i created a new entry) I have therefore drawn the conclusion that the code is somehow activating every worksheet but have no idea why....

任何帮助将不胜感激,如果我错过任何可能有助于诊断的东西,请告诉我.

编辑:另一个奇怪的现象是,当我尝试单步执行代码以找到触发激活事件的确切位置时,不会发生这种情况.

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

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创建之前
• 在SaveAs创建之后
• 在保存更新之前
• 保存更新后
• 在Save Master之前
• 保存大师后
• wsMyCalls

这表明代码在Debug.Print"After Save Master"和End Sub之间执行.那里没有代码???

谢谢

Answer 1

我相信我们在这里看不到您的完整代码。考虑到我们没有自己调试的工作簿，很难诊断。但是，我有一个类似的“欢迎”页面，每次打开我的一本工作簿时都会显示该页面，要求用户激活宏。我确实将 EnableEvents 设置为 false，并在保存之前将工作表置于某种状态，并在保存后将其放回原处。

我将向您详细展示我是如何做到这一点的，因为我感觉您的问题与未在正确的时间禁用 EnableEvents 有关。由于提到的代码不完整，我不确定如何根据您的工作簿的功能来计时。

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

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

在我的 Workbook_BeforeSave 中：

我首先记录 DisplayHeadings 等的当前状态：

Dim Displaytabs As Boolean
Dim DisplayHeadings As Boolean
Dim menu As CommandBar
Dim ligne As CommandBarControl

Displaytabs = ActiveWindow.DisplayWorkbookTabs
DisplayHeadings = ActiveWindow.DisplayHeadings

然后，我重置自定义右键单击，关闭 EnableEvents 和屏幕更新。为了更好地衡量，我将 DisplayWorkbookTabs 设置为 false。

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

然后我运行 Cacherdata（隐藏数据，在下面附加的另一个模块中的子项），保存，然后运行子 Macro_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 将每个工作表设置为 VeryHidden，这样用户就不会在不激活宏的情况下搞乱数据。它记录当前活动工作表，以便用户返回到原来的位置，取消保护工作簿，隐藏工作表，重新保护工作表，仅此而已：

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

错误处理被删除，因为它对显示没有用，但其他所有内容都应该在那里。

编辑：如果这对您没有任何帮助，也许您的问题是因为您创建的工作簿中包含代码（9据我收集），这可能会影响运行代码所需的时间？如果他们自己有一个开放程序，可能就是这样吗？