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

时间：2015-08-27 09:24:37

标签： excel vba excel-vba loops

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

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

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

由于每个项目文档中都有一些VBA代码，这对于将数据与主文档同步至关重要，因此我添加了一个警告工作表，该工作表在没有宏的情况下打开项目文档时显示。这涉及在保存之前和保存事件之后使用工作簿打开以确保仅显示没有宏的警告。以下是每个事件的代码（显然放在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 Document

的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＆＃39;在主文档中创建项目时选中表单信息并输入主文档，然后打开模板项目文档并使用新的唯一文件名保存。然后不受保护，使用新信息进行更新，保护，保存和关闭。然后保存主文档。代码如下（编辑以省略冗长的格式和数据输入）：

表格代码：

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

模块1代码：

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

问题详情： 当我创建一个新条目需要很长时间时，我意外地发现Master Document正在运行每个工作表激活事件中的代码（如上所述）（我在其中一个工作表中有一个诊断信息框，当我发生时神秘地出现创建了一个新条目） 因此我得出结论，代码以某种方式激活每个工作表，但不知道为什么......

任何帮助都将非常感激，如果我错过任何可能有助于诊断的事情，请告诉我。

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

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

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 Create
    • 之后
  • 保存更新前
  • 保存更新后
  • 在保存大师之前
  • 保存大师后
  • wsMyCalls

这表明代码在Debug.Print＆＃34; After Save Master＆＃34;之间执行。和一个结束子。那里没有代码???

由于

1 个答案:

答案 0 :(得分：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（HideData，sub in另一个模块，附在下面）我保存，然后运行sub 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中，它检查工作簿状态是否为Saved。如果是，它会退出。如果没有，它会执行类似的程序：

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使每张表格都非常隐藏，因此用户不会在不激活宏的情况下查看数据。它记录当前活动工作表，以便用户返回原来的位置，取消保护工作簿，隐藏工作表，保护工作簿，以及所有这些：

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，这可能会影响运行代码所需的时间？如果他们自己有一个开放程序，可能就是这样吗？

相关问题
最新问题