- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
本帖最後由 c_c_lai 於 2013-11-28 08:30 編輯
回復 6# missbb
我亦測試過 Hsieh 版大的程式碼，一切正常無訛，
有可能是你在活頁簿間切換移轉時產生的問題。
其實 GBKEE、Hsieh 兩位版大的解題各有其不錯的詮釋。
我將它們予以加註，貼附如下，兩者間各有其巧妙之處，
很值得作為借鏡。- Option Explicit
- Sub Ex() ' GBKEE
- Dim Wb As Workbook, E As Variant, xPath As String, xi As Integer
-
- Set Wb = ThisWorkbook ' 活頁簿 :程式碼所在的
- xPath = Wb.Path & "\" ' 存檔的路徑；譬如： xPath : "D:\TXT\" : String
-
- With Wb.Sheets("password")
- For xi = 1 To Wb.Sheets.Count - 1 ' password 工作表 固定活頁簿中位置最後面(所有工作表的後面)
- Wb.Sheets(xi + 1).Copy ' 指定是哪一個活頁簿的工作表要複製
- ' Example: Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")
- ' This example copies Sheet1, placing the copy after Sheet3.
- ' Remarks: If you don't specify either Before or After, Microsoft Excel creates a new workbook
- ' that contains the copied sheet.
- ActiveWorkbook.Sheets(1).UsedRange.Value = ActiveWorkbook.Sheets(1).UsedRange.Value ' 存文字的值及格式
- ' FileFormat:=xlExcel8 Excel 2003版本 56; xlWorkbookDefault = Excel 2007, or 2010, or 2013.
- ActiveWorkbook.SaveAs Filename:=xPath & Wb.Sheets(xi + 1).Name & ".xls", Password:=Trim(.Cells(xi, "B")), WriteResPassword:="", FileFormat:=xlExcel8
- ' ActiveWorkbook.SaveAs Filename:=xPath & Wb.Sheets(xi + 1).Name & ".xlsx", Password:=Trim(.Cells(xi, "B")), WriteResPassword:="", FileFormat:=xlWorkbookDefault
- ActiveWorkbook.Close False ' 關閉 "D:\A123.xls" 活頁簿、"D:\B456.xls" 活頁簿。
- Next
- End With
- End Sub
- Sub Ex2() ' Hsieh & GBKEE
- Dim f$, fd$, fs$, A As Range, Wb As Workbook
-
- Set Wb = ThisWorkbook ' 活頁簿 :程式碼所在的
- fd = Wb.Path & "\" ' 存檔的路徑
- With Wb.Sheets("PASSWORD")
- For Each A In .Range(.[A1], .[A1].End(xlDown))
- ' A : "A123" : Range/Range
- ' A : "B456" : Range/Range
- ' Sheets("PASSWORD").[A1] : "A123" : Variant/Object/Range
- ' Sheets("PASSWORD").[A1].End(xlDown) : "B456" : Variant/Object/Range
- f = CStr(A)
- fs = fd & f & ".xls"
- Wb.Sheets(f).Copy ' 指定是哪一個活頁簿的工作表要複製
- ' Sheets(f).Copy 執行過後，複製了一活頁簿，內有一名為 "A123" 之工作表單。
- ' ActiveWorkbook.Name : "活頁簿1" : String
- ' ActiveWorkbook.Sheets(1).Name : "A123" : Variant/String
- ' Sheets(f).Copy 執行過後，複製了一活頁簿，內有一名為 "B456" 之工作表單。
- ' ActiveWorkbook.Name : "活頁簿2" : String
- ' ActiveWorkbook.Sheets(1).Name : "B456" : Variant/String
- With ActiveWorkbook
- .ActiveSheet.UsedRange = .ActiveSheet.UsedRange.Value
- ' FileFormat:=xlExcel8 Excel 2003版本 56; xlExcel12 version 12, or 14, or 15 = Excel 2007, or 2010, or 2013.
- .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:="", FileFormat:=xlExcel8
- .Close 0 ' 關閉 "D:\A123.xls" 活頁簿、"D:\B456.xls" 活頁簿。
- End With ' 正式結束 (關閉)。
- Next
- End With
- End Sub
|
|
發表於 2013-11-28 08:24
| 
