返回列表 上一主題 發帖

[發問] 工作表另存時, 取消重覆存檔出錯

[發問] 工作表另存時, 取消重覆存檔出錯

本帖最後由 missbb 於 2024-1-7 23:11 編輯

下列CODE, 我將工作表另存新檔, 但當存檔時有相同名稱的檔案, 我選擇不存檔, 程式仍會存檔在ACTIVE WORKBOOK的PATH, 和出現已"已經新增檔案".

我想如果選擇不重覆存檔, 直接退出程式, 顯示訊息"已經取消重覆存檔", 是如何改CODE呢? 謝謝! TEST FILE SAVE.zip (18.08 KB)
  1. Sub saveactivesheet2()
  2. '目前工作表另存指定位置和檔按名稱

  3. Application.ScreenUpdating = False
  4. 'Application.DisplayAlerts = False

  5. Dim currentworkbook As Workbook
  6. Dim newworkbook As Workbook
  7. Dim currentworksheet As Worksheet
  8. Dim newworkbookname As String
  9. Dim fPath As String

  10. Set currentworkbook = ThisWorkbook
  11. Set currentworksheet = ActiveSheet

  12. newworkbookname = ActiveSheet.Range("S2").Value
  13. fPath = ActiveSheet.Range("S3").Value

  14. Set newworkbook = Workbooks.Add
  15. currentworksheet.Copy before:=newworkbook.Sheets(1)

  16. Range("A1:G100").Select
  17.     Selection.Copy
  18.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  19.         xlNone, SkipBlanks:=False, Transpose:=False
  20.     Columns("H:Y").Select
  21.     Application.CutCopyMode = False
  22.     Selection.Delete Shift:=xlToLeft
  23.     Range("A1").Select
  24.     ActiveWorkbook.Save

  25. On Error Resume Next

  26. newworkbook.SaveAs Filename:=fPath & "\" & newworkbookname

  27. newworkbook.Close

  28. 'Since nothing changed on sheet, provide feedback to user
  29.     MsgBox "已經新增檔案"




  30. End Sub

  31.    
  32.    
複製代碼

回復 2# Andy2483
想請較你新增的CODE應放在我的CODE那一個位置? 我放在ON ERROR RESUME NEXT之下, 即使不皇複存檔, 都是出現 MsgBox "已經新增檔案".

謝謝解答:D

TOP

謝謝,您的指導十分受用

TOP

        靜思自在 : 為人處世要小心細心,但不要「小心眼」。
返回列表 上一主題