帖子: 8
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-1-10
最後登錄: 2021-5-25

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-1-10 00:46 | 只看該作者

關於VBA另存檔案名稱

最近在EXCEL裡面另外做了一個另存新檔的按鈕
因為檔案名稱都是自動由"月份" & "01"命名的檔案名稱
去年11月開始做的
EX:1101 1102 1103
那時並無發現異常
現在1月才遇到狀況
那就是存檔發現前面少了0
EX:101 102 103
試了好多方法都無法讓他前面有0
也試過先將資料存在某儲存格
在用儲存格命名一樣沒有0
不知道有什麼方法可以辦到呢???
請各位大大幫忙我吧....

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 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

那就要找到最大編號的檔名

Function topfile(fn$, fd$) As Integer
fs = Dir(fd & fn)
Do Until fs = ""
If Val(Replace(fs, Val(fn), "")) > topfile Then topfile = Val(Replace(fs, Val(fn), ""))
fs = Dir
Loop
End Function
Sub Save_File()
Dim f$
d = Format(Date, "yymm")
f = ThisWorkbook.Path & "\"
k = Format(topfile(d & "*.xls", f) + 1, "00")
fs = f & d & k & ".xls"
yn = MsgBox("是否另存為" & d & k & ".xls", vbYesNo)
If yn = 6 Then ThisWorkbook.SaveAs fs
End Sub

複製代碼

學海無涯_不恥下問

TOP

peter9527

小學生 Rank: 1

帖子: 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

超級版主 Rank: 8 Rank: 8

帖子: 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兔年全勤獎章

10^#

發表於 2011-2-17 08:32 | 只看該作者

回復 9# peter9527

程式設計最重要的就是規則
你要從命名規則中思考
了解如何套用?
不然別人也不懂你在描述什麼?
你就無法得到解答

學海無涯_不恥下問

TOP

peter9527

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-1-10
最後登錄: 2021-5-25

9^#

發表於 2011-2-16 23:30 | 只看該作者

回復 8# Hsieh

感謝大大的指導
可是我想把他運用在我原本的檔案名稱儲存格式
"當月月份" & "00" + 1
0201 0202 0203....以此類推
怎麼用都用不好
不知該如何修改

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 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兔年全勤獎章

8^#

發表於 2011-2-13 13:20 | 只看該作者

回復 7# peter9527
2003版應該有filesearch可用，因應2007版以上使用DIR函數計算

Function Files_Count(Fd As String, Fs As String) As Integer 'Fd檔案目錄，Fs搜尋檔名
findfs = Dir(Fd & Fs)
Do Until findfs = ""
Files_Count = Files_Count + 1
findfs = Dir
Loop
End Function
Sub add_filename()
k = Files_Count(ThisWorkbook.Path & "\", Format(Date, "yymm") & "*.xls")
fc = Format(Date, "yymm") & "_" & k + 1 & ".xls"
yn = MsgBox("是否要另存為" & fc, vbYesNo)
If yn = 6 Then ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & fc Else MsgBox "檔案未另存"
End Sub

複製代碼

學海無涯_不恥下問

TOP

peter9527

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-1-10
最後登錄: 2021-5-25

7^#

發表於 2011-2-11 21:37 | 只看該作者

回復 peter9527

大意應是如此
Hsieh 發表於 2011-1-11 12:24

Hsieh大大
我又有一個問題了
如果說我想要把fc = fs.fileexists(fd & mymoon & Format(i, "00") & ".xls") '檢查檔名是否存在
這一段改成判斷檔案名稱的前四個數字是否有存在
要怎麼改呢

因為有時候檔案名稱後面可能會加一些註記
這樣下一次另存檔案的抓之前檔名就跑掉了
要自己改檔名...

TOP

peter9527

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-1-10
最後登錄: 2021-5-25

6^#

發表於 2011-1-11 22:19 | 只看該作者

回復 5# Hsieh

太感謝了
竟然只用短短的幾行就搞定了我的難題
真不知道該怎麼感謝你
最後再一次感謝大大的幫忙...真的是非常謝謝你...幫了我大忙

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 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兔年全勤獎章

5^#

發表於 2011-1-11 12:24 | 只看該作者

回復 4# peter9527

大意應是如此

Sub nn()
fd = ThisWorkbook.Path & "\" '存檔目錄
mymoon = Format(Date, "mm") '月份
Set fs = CreateObject("Scripting.FileSystemObject")
Do
i = i + 1
fc = fs.fileexists(fd & mymoon & Format(i, "00") & ".xls") '檢查檔名是否存在
Loop Until fc = False
mystr = mymoon & Format(i, "00") '新檔名稱
yn = MsgBox("是否要另存為" & mystr & ".xls", vbYesNo)
If yn = 6 Then ThisWorkbook.SaveAs fd & mystr & ".xls" Else MsgBox "檔案未另存"
End Sub

複製代碼

學海無涯_不恥下問

TOP

peter9527

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-1-10
最後登錄: 2021-5-25

4^#

發表於 2011-1-11 00:37 | 只看該作者

回復 2# solely

因為公司要的格式就是要這樣
假設是1月的第一筆資料就是0101 第二筆0102...以此類推
所以才會這麼麻煩.....

你的方法確實可行
可是我不知道要怎麼運用在我的程式裡面

程式碼如下
Private Sub CommandButton1_Click()

direct = ThisWorkbook.Path & "\"
session2 = Month(Date) & "01"

Do
Set fs = CreateObject("Scripting.FileSystemObject")
b = fs.fileExists(direct & session2 & ".xls")
session2 = session2 + 1
Loop Until b = False

Var = MsgBox("是否要另存檔案名稱 " & session2 - 1, vbOKCancel, "另存提示")
If Var = vbOK Then
Worksheets("Sheet1").Range("L1") = Date

direct = ThisWorkbook.Path & "\"
session1 = Month(Date) & "01"

Do
Set fs = CreateObject("Scripting.FileSystemObject")
a = fs.fileExists(direct & session1 & ".xls")
session1 = session1 + 1
Loop Until a = False
Application.DisplayAlerts = False
Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

ActiveWorkbook.SaveAs Filename:=direct & session2 - 1 & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
MsgBox "檔案名稱 " & session2 - 1 & " 另存成功!!"
End If

If Var = vbCancel Then
End If
End Sub

TOP

關於VBA另存檔案名稱

關於VBA另存檔案名稱

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]