有關另存新檔問題..

帖子: 65
主題: 0
精華: 0
積分: 120
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2010-5-15
最後登錄: 2010-7-16

15^#

發表於 2010-6-7 22:33 | 只看該作者

回復 10# GBKEE

感謝 GBKEE 版大指教， Object相關一直都是小弟我比較弱的塊，還希望版大能不吝指正並提點，因為說實在的相關教材實在有限。

Hsieh

超級版主 Rank: 8 Rank: 8

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

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

14^#

發表於 2010-6-7 18:36 | 只看該作者

回復 13# gca78000

要點選LISTBOX1的日期後再按按鈕

學海無涯_不恥下問

帖子: 53
主題: 16
精華: 0
積分: 74
點名: 0
作業系統: windows xp
軟體版本: OFFICE 2000
閱讀權限: 20
性別: 男
註冊時間: 2010-6-6
最後登錄: 2015-12-10

13^#

發表於 2010-6-7 18:33 | 只看該作者

回復 12# gca78000

MyDate = ListBox1.Text

帖子: 53
主題: 16
精華: 0
積分: 74
點名: 0
作業系統: windows xp
軟體版本: OFFICE 2000
閱讀權限: 20
性別: 男
註冊時間: 2010-6-6
最後登錄: 2015-12-10

12^#

發表於 2010-6-7 18:32 | 只看該作者

回復 11# Hsieh

謝謝大大指導附件我還無法下載
但依程式碼卻會出錯

Hsieh

超級版主 Rank: 8 Rank: 8

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

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

11^#

發表於 2010-6-7 17:54 | 只看該作者

本帖最後由 Hsieh 於 2010-6-7 18:13 編輯

我的看法樓主似乎是想讓工作表另存成XLS檔案
新增一自訂表單,表單中設置一個清單方塊及一個按鈕
表單模組程式

Private Sub CommandButton1_Click()
Dim MyDate As String
MyDate = ListBox1.Text
ActiveSheet.Copy
ActiveWorkbook.SaveAs "D:\" & ActiveSheet.[B2] & MyDate & ".xls"
End Sub
Private Sub UserForm_Initialize()
With ActiveSheet
For Each a In .Range(.[B3], .[B65536].End(xlUp))
ListBox1.AddItem a.Text
Next
End With
End Sub

複製代碼

一般模組程式碼

Sub OpenForm() '快速鍵Ctrl+m
UserForm1.Show
End Sub

複製代碼

如附件

001.rar (12.96 KB)

學海無涯_不恥下問

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

10^#

發表於 2010-6-7 16:25 | 只看該作者

本帖最後由 GBKEE 於 2010-6-7 16:30 編輯

回復 7# victorl
直接將檔案複製即可不必開開關關

Sub Ex()
Dim D
Set D = CreateObject("Scripting.FileSystemObject")
ActiveWorkbook.Save
D.CopyFile ActiveWorkbook.FullName, "D:\" & Range("B1") & Range("B3") & ".xls"
End Sub

複製代碼

帖子: 53
主題: 16
精華: 0
積分: 74
點名: 0
作業系統: windows xp
軟體版本: OFFICE 2000
閱讀權限: 20
性別: 男
註冊時間: 2010-6-6
最後登錄: 2015-12-10

9^#

發表於 2010-6-7 15:51 | 只看該作者

回復 8# gca78000

再請問大大一下.
如另存新檔後要把內的 vba程式碼也消除要如何寫
請指導謝謝...

帖子: 53
主題: 16
精華: 0
積分: 74
點名: 0
作業系統: windows xp
軟體版本: OFFICE 2000
閱讀權限: 20
性別: 男
註冊時間: 2010-6-6
最後登錄: 2015-12-10

8^#

發表於 2010-6-7 15:38 | 只看該作者

回復 7# victorl

謝謝大大指導已經可以..小弟受益匪淺.
再請問一下如儲存格B3到B33要自動秀出日期表單讓我可以挑選要如何寫..
請指導謝謝

victorl

帖子: 65
主題: 0
精華: 0
積分: 120
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2010-5-15
最後登錄: 2010-7-16

7^#

發表於 2010-6-7 13:44 | 只看該作者

請問你是想要另存新檔再開啟原檔案嗎?
請參考
Orig = ThisWorkbook.Path & "\" & ThisWorkbook.Name '取得原檔案路徑及名稱
ActiveWorkbook.SaveAs Filename:="D:\" & Range("B1").Value & Range("B3").Value & ".xls" ' 依要求B1&B3內容另存新檔
newfile = ActiveWorkbook.Name
Workbooks.Open Filename:=Orig ' 開啟原檔案
Workbooks(newfile).Close ' 關閉另存之檔案
註. 另存新檔之前的變更不會存在於原檔案喔