請問如何將指定的工作表!另存成一個新的活頁簿(.xls檔)! - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 請問如何將指定的工作表!另存成一個新的活頁簿(.xls檔)!

返回列表下一主題上一主題發帖

[發問] 請問如何將指定的工作表!另存成一個新的活頁簿(.xls檔)!

超級版主 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兔年全勤獎章

1^# 跳轉到 »

發表於 2011-11-12 15:06 | 顯示全部帖子

回復 1# 棋語鳥鳴

Sub Ex()
With ActiveWorkbook '作用中的活頁簿
'ThisWorkbook '程式碼所在的活頁簿
'WorkbookS(1) '指定開啟活頁簿中的索引值
'WorkbookS("Test") '指明開啟活頁簿中的名稱
.SaveCopyAs Sheets(1).[B2] & Sheets(1).[B1] & "." & Split(.Name, ".")(1)
'.SaveCopyAs 另存新檔的方法
'Split(.Name, ".")(1) ->傳回活頁簿的副檔名
End With
End Sub

複製代碼

超級版主 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兔年全勤獎章

2^#

發表於 2011-11-12 19:19 | 顯示全部帖子

回復 3# 棋語鳥鳴

Option Explicit
Sub Ex()
Dim E As Object
ActiveWorkbook.Sheets(1).Copy '複製Sheets(1) 一張工作表到新的活頁簿
With ActiveWorkbook '複製後的新活頁簿是 **作用中的活頁簿**
For Each E In .VBProject.VBComponents '活頁簿專案中元件的集合物件
E.CodeModule.DeleteLines 1, E.CodeModule.CountOfLines '刪除所有的程式碼
Next
.SaveCopyAs .Sheets(1).[B2] & .Sheets(1).[B1] & "." & Split(.Name, ".")(1)
.Close False '關閉檔案 (不存檔)
End With
End Sub

複製代碼

超級版主 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兔年全勤獎章

3^#

發表於 2011-11-13 07:23 | 顯示全部帖子

回復 7# 棋語鳥鳴

Sub Ex()
Dim Bo As Workbook, E As Object, S As String
Set Bo = ActiveWorkbook
Bo.Sheets(1).Copy '複製Sheets(1) 一張工作表到新的活頁簿
With ActiveWorkbook '複製後的新活頁簿是 **作用中的活頁簿**
For Each E In .VBProject.VBComponents '活頁簿專案中元件的集合物件
E.CodeModule.DeleteLines 1, E.CodeModule.CountOfLines '刪除所有的程式碼
Next
.SaveCopyAs .Sheets(1).[B2] & .Sheets(1).[B1] & "." & IIf(Bo.Path <> "", Split(Bo.Name, ".")(1), "xls")
.Close False '關閉檔案 (不存檔)
End With
End Sub

複製代碼

超級版主 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兔年全勤獎章

4^#

發表於 2011-11-13 09:53 | 顯示全部帖子

回復 9# 棋語鳥鳴

Sub Ex()
Dim Bo As Workbook, Save_Name As String, E As Object
With ActiveWorkbook '*** 要複製的活頁簿 ***
'ActiveWorkbook '作用中的活頁簿
'ThisWorkbook '程式碼所在的活頁簿
'WorkbookS(1) '指定開啟活頁簿中的索引值
'WorkbookS("Test") '指明開啟活頁簿中的名稱'
Save_Name = .Sheets(1).[B2] & .Sheets(1).[B1] & ".xls"
.Sheets("工作表名稱").Copy '指定複製一張工作表到新的活頁簿
End With
With ActiveWorkbook '複製後的新活頁簿是 **作用中的活頁簿**
For Each E In .VBProject.VBComponents '活頁簿專案中元件的集合物件
E.CodeModule.DeleteLines 1, E.CodeModule.CountOfLines '刪除所有的程式碼
Next
.SaveCopyAs Save_Name
.Close False '關閉檔案 (不存檔)
End With
End Sub

複製代碼

靜思自在 : 自己害自己，莫過於亂發脾氣。

返回列表下一主題上一主題