爲什麼新的工作簿打開時宏停止運行？

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 

的在那裏我也做了一些小的重構你的原代碼