返回列表 上一主題 發帖

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

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
1# 跳轉到 »
發表於 2024-1-8 08:46 | 顯示全部帖子
回復 1# missbb


     If Dir(fPath & "\" & newworkbookname) <> "" Then Msgbox "已經取消重覆存檔"： Exit Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
2#
發表於 2024-1-10 08:27 | 顯示全部帖子
回復 3# missbb


    謝謝論壇,謝謝前輩回復
以下是建議方案,請前輩參考

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
Dim filename As String, fPath As String
filename = [S2]: fPath = [S3]: If Dir(fPath, vbDirectory) = "" Then MkDir fPath
If Dir(fPath & "\" & filename & ".xlsx") <> "" Then
   MsgBox "指定的 " & filename & ".xlsx 已經存在! 沒有執行存檔": Exit Sub
End If
ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 站在半路，比走到目標更辛苦。
返回列表 上一主題