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

Question

我正在使用以下代码片段来保存电子表格，并将其设置为仅值并重新保存。但是，工作簿打开然后宏停止运行。

这是为什么？我该如何阻止它？我试过设置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

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

如何解决你的问题：使用Worksheets对象的Copy()方法的所有工作表从一个工作簿复制到一个新的（原来只是为格式的公式将无法正常工作）。然后，您需要使用.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

使用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 

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