为什么打开新工作簿时macros停止运行？

我正在使用下面的代码片断来保存电子表格，并将其保存为值并重新保存。 但是，工作簿打开然后macros停止运行。

为什么是这样？ 我该如何阻止它？ 我试着设置ScreenUpdating = False无济于事。

 Sub saveReport() Dim nwkbk As Workbook Dim thsWkbk As Workbook Set thsWkbk = ThisWorkbook nwkbkPath = thsWkbk.Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & thsWkbk.Name ApplicationDisplayAlerts = False thsWkbk.SaveCopyAs nwkbkPath Set nwkbk = Workbooks.Open(nwkbkPath, False) For w = 1 To nwkbk.Sheets.Count nwkbk.Sheets(w).UsedRange = nwkbk.Sheets(w).UsedRange.Value Next w For wsp = 1 To nwkbk.Sheets.Count nwkbk.Sheets(wsp).Protect Password:="SettleDownBenny" Next wsp Application.DisplayAlerts = False nwkbk.Save nwkbk.Close End Sub 

Answer 1

答案：您的macros停止运行，因为它保存为xlsm 。 在打开时可能会有事件处理程序启动，从而停止原始macros。 更新：在这种情况下，它是在打开xlsm时自动运行的Auto_Open方法。

如何解决您的问题：使用Worksheets对象的Copy()方法将Worksheets簿中的所有工作表复制到新工作表（最初仅用于格式，因为公式不起作用）。 然后，您需要使用.Value属性单独将这些值复制为值，以确保所有值逐字复制。然后调用SaveAs()方法来保存它。

代码如下：

 Sub saveReport() Dim nwkbkPath As String Dim w As Long Set thsWorkbook = ThisWorkbook With thsWorkbook '<--| reference 'ThisWorkbook' nwkbkPath = .Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & GetName(.Name) '<--| use only the "strict" name (no extension) of ThisWorkbook .Sheets.Copy '<--| copy all worksheets from 'thsWkbk' to a new workbook, which also becomes the 'ActiveWorkbook' End With On Error GoTo ErrHandler Application.DisplayAlerts = False Set nwWorkbook = ActiveWorkbook For w = 1 To nwWorkbook.Sheets.Count nwWorkbook.Sheets(w).UsedRange = thsWorkbook.Sheets(w).UsedRange.Value Next w For w = 1 To nwWorkbook.Sheets.Count nwWorkbook.Sheets(w).Protect Password:="SettleDownBenny" Next w nwWorkbook.SaveAs nwkbkPath ActiveWorkbook.Close ErrHandler: Application.DisplayAlerts = True End Sub Function GetName(wbName As String) As String GetName = Left(wbName, InStrRev(wbName, ".") - 1) End Function 

Answer 2

使用Worksheets对象的Copy()方法将Worksheets簿中的所有工作表复制到新的工作表上，在该工作表上执行所有需要的操作，最后调用SaveAs()方法

如下

 Option Explicit Sub saveReport() Dim nwkbkPath As String Dim w As Long With ThisWorkbook '<--| reference 'ThisWorkbook' nwkbkPath = .Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & GetName(.name) '<--| use only the "strict" name (no extension) of ThisWorkbook .Sheets.Copy '<--| copy all worksheets from 'thsWkbk' to a new workbook, which also becomes the 'ActiveWorkbook' End With On Error GoTo ErrHandler Application.DisplayAlerts = False With ActiveWorkbook '<--| reference the ActiveWorkbook For w = 1 To .Sheets.Count .Sheets(w).UsedRange = .Sheets(w).UsedRange.Value Next w For w = 1 To .Sheets.Count .Sheets(w).Protect Password:="SettleDownBenny" Next w .SaveAs nwkbkPath End With ActiveWorkbook.Close ErrHandler: Application.DisplayAlerts = True End Sub Function GetName(wbName As String) As String GetName = Left(wbName, InStrRev(wbName, ".") - 1) End Function 

在那里我也做了一些你的原代码的重构