保存工作簿時出現新的Excel VBA編譯錯誤

Question

我一直在使用下面的代碼為我的工作簿中的每個工作表成功創建並保存一個新的工作簿。 現在嘗試運行它時，出現錯誤“編譯錯誤參數數量錯誤或屬性分配無效”。 我不明白為什么它現在不起作用。 它以前做過。 我確實要在姓氏中注明日期。 如果我用標記為'的wb.SaveAs行運行代碼，則效果很好。 現在似乎不喜歡格式部分。 任何想法有什么不同，為什么？ 謝謝。

Sub Make_Workbooks()

Dim ws As Worksheet
Dim wb As Workbook


  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

For Each ws In ThisWorkbook.Worksheets

Set wb = Workbooks.Add
'wb.SaveAs ThisWorkbook.Path & "\" & ws.Name
wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd") & ".xlsx"
ws.Copy Before:=wb.Worksheets(1)
wb.Close SaveChanges:=True

Next ws

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Answer 1

我無法在系統上復制您的問題，但是以下代碼最大程度地減少了對新Workbook對象的顯式創建和跟蹤，因此在不同環境中的錯誤發生率可能會降低：

Sub Make_Workbooks()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    ws.Copy     'Copies current sheet to new workbook
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ws.Name & "_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
    ActiveWindow.Close
Next ws

結束子

Answer 2

用於使用SaveAs的語法應為FileName ， FileFormat ，...。

在您的代碼中，它應該是：

wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd"), xlOpenXMLWorkbook

（ xlOpenXMLWorkbook =“ .xlsx”）

如果您每天要運行幾次代碼，則由於ThisWorkbook.Path & "\\" & ws.Name & Format(Date, "yyyy-mm-dd")如果要覆蓋現有文件，則會收到一條消息。在同一天將具有相同的String 。

如果要自動覆蓋以前的文件，則添加行Application.DisplayAlerts = False 。

碼

Option Explicit

Sub Make_Workbooks()

Dim ws As Worksheet
Dim wb As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each ws In ThisWorkbook.Worksheets
    Set wb = Workbooks.Add
    ' add this line to automatically overwrite the exisitng file (not getting the MsgBox on every time)
    Application.DisplayAlerts = False
    wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd"), xlOpenXMLWorkbook
    ws.Copy Before:=wb.Worksheets(1)
    wb.Close SaveChanges:=True
Next ws

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Edit1 ：如果要確保2個文件名永遠不會具有相同的名稱，則可以使用Now函數：

wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Now, "yyyy-mm-dd_hh_mm_ss"), xlOpenXMLWorkbook