返回列表 上一主題 發帖

[發問] VBA另存新檔出錯

missbb

帖子
216 
主題
71 
精華
0 
積分
292 
點名
0  
作業系統
window xp 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-27 
最後登錄
2024-9-28 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2024-1-27 01:39 | 只看該作者

[發問] VBA另存新檔出錯

我有一個EXCEL檔案, 內有兩個工作表, 每個工作表都使用快捷按鈕執行下列的VBA CODE, 將工作表按指定路徑另存新檔案.

問題(1) 是有些時候執行VBA CODE時, 會顯示另存檔已經存在, 但其實會在指定路徑內, 自動增加了一何"PATH"的FOLDER, 再在FOLDER 內另存名稱是"FILENAME"的工作表.  不知是否兩個工作表共用一個VBA CODE出現問題? 希望賜教!
問題(2) 如果另存新檔案時, 已有相同名稱檔案存在,可否要取消存檔, 改為仍然存檔, 但自行在檔案名稱後加上V1, V2, V3等, 如此類推?
  1. Sub activeSave_2c()

  3. Application.ScreenUpdating = False
  4. Dim filename As String, fPath As String
  5. filename = [S2]: fPath = [S3]: If Dir(fPath, vbDirectory) = "" Then MkDir fPath

  7. If Dir(fPath & "\" & filename & ".xlsx") <> "" Then
  8.    MsgBox "指定的 " & filename & ".xlsx 已經存在! 沒有執行存檔": Exit Sub
  9. End If

  11. ActiveSheet.Copy
  12. [A1:G100].Value = [A1:G100].Value
  13. [H:Y].Delete: [A1].Select
  14. ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & ".xlsx"
  15. ActiveWorkbook.Close
  16. MsgBox "已經新增檔案": ThisWorkbook.Activate
  17. End Sub
複製代碼
收藏 分享

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-12-27 
2#
發表於 2024-1-27 11:22 | 只看該作者
Sub activeSave_2c()
Dim filename As String, fPath As String,k%, km$
Application.ScreenUpdating = False
filename = [S2]: fPath = [S3]
If Dir(fPath, vbDirectory) = "" Then MkDir fPath

for k = 99 to 1 step -1
     km="_V" & format(k, "00")
     If Dir(fPath & "\" & filename & km & ".xlsx") <> "" Then exit for
next k
if k>=99 then msgbox "檔案序號已用完!!  ":exit sub
km="_V" & format(k+1, "00")

ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & km & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate

TOP

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-12-27 
3#
發表於 2024-1-27 11:27 | 只看該作者
檔名+日期時間//更符合分次建檔

Sub activeSave_3c()
Dim filename As String, fPath As String,k%, km$
Application.ScreenUpdating = False
filename = [S2]: fPath = [S3]
If Dir(fPath, vbDirectory) = "" Then MkDir fPath

km="_V" & format(now, "yymmdd-hhmmss")

ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & km & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate

TOP

missbb

帖子
216 
主題
71 
精華
0 
積分
292 
點名
0  
作業系統
window xp 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-27 
最後登錄
2024-9-28 
4#
發表於 2024-1-29 19:59 | 只看該作者
回復 3# 准提部林


   多謝指導:)

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事，就等於壽命有多長。因此必須與時間競爭，切莫使時日空過。
返回列表 上一主題