12
返回列表 上一主題 發帖

關於VBA另存檔案名稱

peter9527

帖子
8 
主題
2 
精華
0 
積分
11 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
10 
性別
男 
註冊時間
2011-1-10 
最後登錄
2021-5-25 
11# 跳轉到 »
發表於 2011-2-24 02:46 | 只看該作者
回復 10# Hsieh


    Hsieh大大 不好意思 前幾天比較忙 現在才有空
其實我那個問題主要是又碰到命名方式 "月份"&"數字"
數字的格式部份...10以下的數字前面沒有"0"...不過我已經修改好了

最後我有測試
大致上都可正常運作
不過我後來發現有一個小問題
如果把之前儲存的其中一個檔案刪除掉
之後的儲存檔案就會出現問題了
會跟最後一次儲存的檔案名稱重複儲存
我以為是我有不小心改錯程式碼
用Hsieh大大的原始碼去測試
也是有一樣的情況發生...

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
258  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-28 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
12#
發表於 2011-2-24 11:30 | 只看該作者
回復 11# peter9527

那就要找到最大編號的檔名
  1. Function topfile(fn$, fd$) As Integer
  2. fs = Dir(fd & fn)
  3. Do Until fs = ""
  4. If Val(Replace(fs, Val(fn), "")) > topfile Then topfile = Val(Replace(fs, Val(fn), ""))
  5. fs = Dir
  6. Loop
  7. End Function
  8. Sub Save_File()
  9. Dim f$
  10. d = Format(Date, "yymm")
  11. f = ThisWorkbook.Path & "\"
  12. k = Format(topfile(d & "*.xls", f) + 1, "00")
  13. fs = f & d & k & ".xls"
  14. yn = MsgBox("是否另存為" & d & k & ".xls", vbYesNo)
  15. If yn = 6 Then ThisWorkbook.SaveAs fs
  16. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 道德是提昇自我的明燈，不該是呵斥別人的鞭子。
12
返回列表 上一主題