通过宏关闭并保存工作簿，而无需运行'beforesave'事件

Question

我有一个遵循相同模板的工作簿列表，所有工作簿都有一个宏"beforesave"事件，它基本上在工作表上创建一个保存登录，列出保存工作簿的人的时间和用户id。

因此，有时我需要更改所有工作簿中的公式，由于手动关闭和保存每个工作簿大约需要一分钟的时间，我创建了一个宏，打开所有工作簿，更改我需要更改的内容，然后关闭保存。这将为我节省大量时间，因为这个过程总共花费了我大约30分钟的时间，而且很无聊。

问题是：当宏试图关闭并保存工作簿时，"beforesave"事件无法正常运行，因此工作簿无法使用宏进行保存和关闭。由于某种原因，该事件似乎在宏中被跳过了。。。

为了解决这个问题，我想运行这个宏来对所有工作簿进行所有更改，跳过beforesave事件(如果必要)，并在最后保存并关闭它们。

请帮忙？

尝试逐行运行宏，当它到达事件部分时，它会调用它，但由于某种原因，它会停留在同一工作表中，而不是转到日志工作表，因此会将日志信息写入错误的工作表。无论如何，逐行运行对我来说显然不起作用，因为它基本上与我自己手动完成流程相同。

Sub DoStuff()
Dim Row As Integer
Dim Col As Integer
Dim wbCopy As Workbook
Dim wbPaste As Workbook
Dim wbBP As Workbook
For Col = 4 To 4
ThisWorkbook.Activate
Set wbBP = Workbooks.Open(Cells(1, Col), False)
ThisWorkbook.Activate
Set wbCopy = Workbooks.Open(Cells(2, Col), False, True)
For Row = 3 To 19
ThisWorkbook.Activate
SetAttr Cells(Row, Col), vbNormal
Set wbPaste = Workbooks.Open(Cells(Row, Col), False)
wbCopy.Activate
Sheets("Base").Activate
Range("A7:EQ500").AutoFilter
wbPaste.Activate
Sheets("Base").Activate
Range("A7:EQ500").AutoFilter
wbCopy.Activate
Sheets("Base").Activate
Range("AL8:AS8").Copy
wbPaste.Activate
Sheets("Base").Activate
Range("AL8:AS" & Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
wbPaste.Close True
ThisWorkbook.Activate
SetAttr Cells(Row, Col), vbReadOnly
Next Row
wbCopy.Close False
wbBP.Close False
Next Col
End Sub

运行宏以进行我需要的更改，并正确保存和关闭所有涉及的工作簿。

Answer 1

欢迎使用SO。如果您可以运行wbPaste工作簿中的任何事件来执行更新作业，那么标题的答案就太简单了。只需在保存文件之前添加Application.EnableEvents = False，并在保存完成后使其成为真即可。

同样基于@Mathieu Guindon评论的观点，你的帖子对你的确切要求和Activate的无意使用感到困惑。我只是对你的代码进行了一点重组，以避免在更新期间运行任何事件。

Sub DoStuff()
Dim Row As Integer
Dim Col As Integer
Dim wbCopy As Workbook
Dim wbPaste As Workbook
Dim wbBP As Workbook
‘Worksheet name “FileList” used for trial . May please change to yours  or use activesheet 
With ThisWorkbook.Worksheets("FileList")    
For Col = 4 To 4
‘Could not understand why wbBP opened, it is not used anywhere in the code 
Set wbBP = Workbooks.Open(.Cells(1, Col), False)
Set wbCopy = Workbooks.Open(.Cells(2, Col), False, True)
‘ This will disable any events including ‘BeforeSave’ events
Application.EnableEvents = False
‘Disabling  ScreenUpdating  will increase efficiency if large files used
Application.ScreenUpdating = False
For Row = 3 To 19
SetAttr .Cells(Row, Col), vbNormal           ‘ failed to understand use of SetAttr
Set wbPaste = Workbooks.Open(.Cells(Row, Col), False)
wbCopy.Sheets("Base").Range("A7:EQ500").AutoFilter
wbPaste.Sheets("Base").Range("A7:EQ500").AutoFilter
wbCopy.Sheets("Base").Range("AL8:AS8").Copy
wbPaste.Sheets("Base").Range("AL8:AS" & Cells(Rows.Count , 1).End(xlUp).Row).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
wbPaste.Close True
SetAttr .Cells(Row, Col), vbReadOnly
Next Row
Application.EnableEvents = True
Application.ScreenUpdating = True
wbCopy.Close False
wbBP.Close False
Next Col
End With
End Sub

如果你想在wbPaste工作簿中运行其他事件，并且只想避免只运行BeforeSave事件或该事件中的一部分代码，并且你有权修改事件代码，那么你可以根据我的评论，通过检查单元格的值，在"BeforeSave"事件代码中引入一个分支。如果担心单元格值被用户意外修改/删除，最好引入检查"CustomDocumentProperties">

您可以选择添加&从所有wbPaste工作簿的文档面板中设置自定义文档属性。我更愿意通过一次性运行代码来介绍自定义文档属性BeforeSaveCheck'

Sub testOnce()
Dim Row As Integer
Dim Col As Integer
Dim wbPaste As Workbook
Col = 4
With ThisWorkbook.Worksheets("FileList")
Application.EnableEvents = False
'Application.ScreenUpdating = False
For Row = 3 To 19
SetAttr .Cells(Row, Col), vbNormal
Set wbPaste = Workbooks.Open(.Cells(Row, Col), False)
wbPaste.CustomDocumentProperties.Add Name:="BeforeSaveCheck", LinkToContent:=False, Type:=msoPropertyTypeBoolean, Value:=True
wbPaste.Close True
SetAttr .Cells(Row, Col), vbReadOnly
Next Row
Application.EnableEvents = True
'Application.ScreenUpdating = True
End With
End Sub

现在您可以介绍wbPaste工作簿(如)的BeforeSave事件中的一个简单分支

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ThisWorkbook.CustomDocumentProperties("BeforeSaveCheck") Then
‘’’’’’’’’’’’’
‘The code section you want to bypass while updating with macro
‘’’’’’’’’’’’
End If
End Sub

并在打开事件中将属性设置为True

Private Sub Workbook_Open()
ThisWorkbook.CustomDocumentProperties("BeforeSaveCheck") = True
End Sub

最后在sub dostuff删除行

Application.EnableEvents = False
Application.EnableEvents = True

并添加行

ThisWorkbook.CustomDocumentProperties("BeforeSaveCheck") = False
wbPaste.Close True