Board logo

標題: [發問] 多張工作表另存活頁簿及抓住預設密碼 [打印本頁]
作者: missbb    時間: 2013-11-24 20:11     標題: 多張工作表另存活頁簿及抓住預設密碼

[發問] 多張工作表另存活頁簿及抓住預設密碼
各位專家
本人正學習VBA, 請問如在活頁簿內有3張工作表
第1張工作表名為"PASSWORD",  已列出A123的PASSWORD在B1, B456的PASSWORD在B2
第2張工作表名為A123
第3張工作表名為B456

請教VBA寫法:
第2張工作表名為A123另存一個名為A123的活頁簿,. 並能取工作表名"PASSWORD"內的B1內的成為活頁簿密碼, 並只存文字的值及格式
第3張工作表名為B456另存一個名為B456的活頁簿,. 並能取工作表名"PASSWORD"內的B2內的成為活頁簿密碼, 並只存文字的值及格式

有労賜教!
作者: GBKEE    時間: 2013-11-25 10:37

回復 1# missbb
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Wb As Workbook, E As Variant, xPath As String, i As Integer
  4.     Set Wb = ThisWorkbook           '活頁簿 :程式碼所在的
  5.     'Set Wb = Workbooks(2)          '活頁簿 :第2個
  6.     'Set Wb = Workbooks("a.xls")    '活頁簿 :指定名稱
  7.     'Set Wb = ActiveWorkbook        '活頁簿 :作用中的
  8.     xPath = Wb.Path & "\"                '存檔的路徑
  9.     With Wb.Sheets("password")
  10.         i = 1
  11.         For Each E In Array("a123", "b456")
  12.             Wb.Sheets(E).Copy
  13.             ActiveWorkbook.Sheets(1).UsedRange.Value = ActiveWorkbook.Sheets(1).UsedRange.Value           '存文字的值及格式
  14.             ActiveWorkbook.SaveAs Filename:=xPath & E & ".xls", Password:=.Cells(i, "b"), WriteResPassword:=""
  15.             ActiveWorkbook.Close False
  16.         Next
  17.         i = i + 1
  18.     End With
  19. End Sub
複製代碼
作者: missbb    時間: 2013-11-25 21:23

回復 2# GBKEE



您好, 第一個檔案無問題, 但開啟第二個檔案時, 均說密碼不符. 已試驗兩次及用不同密碼也不行.:(  第二個檔案的密碼是存在B2儲存格內).

此外, 現在只是存兩個檔案, 但如果有20個檔案, 是否要將20個榴案的名字都輸入在程式內.
**For Each E In Array("a123", "b456"......."第20個檔")

多謝!
作者: GBKEE    時間: 2013-11-26 07:52

回復 3# missbb
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Wb As Workbook, E As Variant, xPath As String, I As Integer
  4.     Set Wb = ThisWorkbook          '活頁簿 :程式碼所在的
  5.     'Set Wb = Workbooks(2)          '活頁簿 :第2個
  6.     'Set Wb = Workbooks("a.xls")  '活頁簿 :指定名稱
  7.     'Set Wb = ActiveWorkbook      '活頁簿 :作用中的
  8.     xPath = Wb.Path & "\"            '存檔的路徑
  9.     With Wb.Sheets("password")
  10.         '*********這活頁簿有20個工作表+"password"*************************************************
  11.         For I = 1 To Wb.Sheets.Count - 1 'password 工作表 固定活頁簿中位置最後面(所有工作表的後面)
  12.         ' For i = 2 To Wb.Sheets.Count     'password 工作表 固定活頁簿中位置最前面(第1個)
  13.         '*********這活頁簿不只有20個工作表+"password" -> 活頁簿中20個工作表是連續在如(5-24)的索引位置**************
  14.         ' For i = 5 To 24
  15.         '********************************************************************************************
  16.             Wb.Sheets(I).Copy
  17.             ActiveWorkbook.Sheets(1).UsedRange.Value = ActiveWorkbook.Sheets(1).UsedRange.Value           '存文字的值及格式
  18.             ActiveWorkbook.SaveAs Filename:=xPath & Wb.Sheets(I).Name & ".xls", Password:=Trim(.Cells(I, "b")), WriteResPassword:=""
  19.                        '當 For i = 1  ->  Password:=Trim(.Cells(i, "b"))
  20.                        '當 For i = 2  ->  Password:=Trim(.Cells(i - 1, "b"))
  21.                        '當 For i = 3  ->  Password:=Trim(.Cells(i - WB.Sheets(3).Index + 1, "b"))
  22.                        '當 For i = 4  ->  Password:=Trim(.Cells(i - WB.Sheets(4).Index + 1, "b"))
  23.                         '密碼會錯誤,可能是前後有空白字元 ,Trim:消除前後空白字元 ->   Password:=Trim(.Cells(i, "b"))
  24.             ActiveWorkbook.Close False
  25.         Next
  26.     End With
  27. End Sub
複製代碼
作者: Hsieh    時間: 2013-11-26 13:49

回復 3# missbb

若工作表排序錯誤就容易出錯
建議將工作表對應密碼表寫再PASSWORD工作表(如圖)
直接取用工作表名稱對應密碼避免出錯
    [attach]16876[/attach]
  1. Sub ex()
  2. Dim f$, fd$, fs$, A As Range
  3. fd = "D:\"
  4. With Sheets("PASSWORD")
  5. For Each A In .Range(.[A1], .[A1].End(xlDown))
  6.    f = CStr(A)
  7.    fs = fd & f & ".xls"
  8.    Sheets(f).Copy
  9.    With ActiveWorkbook
  10.    .ActiveSheet.UsedRange = .ActiveSheet.UsedRange.Value
  11.    .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:=""
  12.    .Close 0
  13.    End With
  14. Next
  15. End With
  16. End Sub
複製代碼
作者: missbb    時間: 2013-11-27 13:18

回復 5# Hsieh

顯示偵錯COPY方法失敗 ->    Sheets(f).Copy

我作錯了甚麼?:Q
作者: GBKEE    時間: 2013-11-27 13:35

回復 6# missbb
  1. Sub ex()
  2. Dim f$, fd$, fs$, A As Range, Wb As Workbook
  3.     Set Wb = ThisWorkbook          '活頁簿 :程式碼所在的
  4.     'Set Wb = Workbooks(2)          '活頁簿 :第2個
  5.     'Set Wb = Workbooks("a.xls")  '活頁簿 :指定名稱
  6.     'Set Wb = ActiveWorkbook      '活頁簿 :作用中的
  7.     fd = "D:\"
  8.     With Wb.Sheets("PASSWORD")
  9.         For Each A In .Range(.[A1], .[A1].End(xlDown))
  10.         f = CStr(A)
  11.         fs = fd & f & ".xls"
  12.         Wb.Sheets(f).Copy
  13.         '如有多個活頁簿啟時,且ActiveWorkbook,不是要複製工作表的活頁簿.
  14.         '指定是哪一個活頁簿的工作表要複製
  15.         With ActiveWorkbook
  16.             .ActiveSheet.UsedRange = .ActiveSheet.UsedRange.Value
  17.             .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:=""
  18.             .Close 0
  19.         End With
  20.     Next
  21.     End With
  22. End Sub
複製代碼
作者: ML089    時間: 2013-11-27 23:28

回復 6# missbb


我測試是OK
可能是PASWORG工作表A欄內的名稱與工作名稱沒有對到
作者: c_c_lai    時間: 2013-11-28 08:24

本帖最後由 c_c_lai 於 2013-11-28 08:30 編輯

回復 6# missbb
我亦測試過 Hsieh 版大的程式碼，一切正常無訛，
有可能是你在活頁簿間切換移轉時產生的問題。
其實 GBKEE、Hsieh 兩位版大的解題各有其不錯的詮釋。
我將它們予以加註，貼附如下，兩者間各有其巧妙之處，
很值得作為借鏡。
  1. Option Explicit

  3. Sub Ex()         '  GBKEE
  4.     Dim Wb As Workbook, E As Variant, xPath As String, xi As Integer
  5.    
  6.     Set Wb = ThisWorkbook             '  活頁簿 :程式碼所在的
  7.     xPath = Wb.Path & "\"             '  存檔的路徑；譬如： xPath : "D:\TXT\" : String
  8.    
  9.     With Wb.Sheets("password")
  10.         For xi = 1 To Wb.Sheets.Count - 1   '  password 工作表 固定活頁簿中位置最後面(所有工作表的後面)
  11.             Wb.Sheets(xi + 1).Copy          '  指定是哪一個活頁簿的工作表要複製
  12.             '  Example:  Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")
  13.             '  This example copies Sheet1, placing the copy after Sheet3.
  14.             '  Remarks:  If you don't specify either Before or After, Microsoft Excel creates a new workbook
  15.             '            that contains the copied sheet.
  16.             ActiveWorkbook.Sheets(1).UsedRange.Value = ActiveWorkbook.Sheets(1).UsedRange.Value  '  存文字的值及格式
  17.                 '  FileFormat:=xlExcel8   Excel 2003版本 56; xlWorkbookDefault = Excel 2007, or 2010, or 2013.
  18.            ActiveWorkbook.SaveAs Filename:=xPath & Wb.Sheets(xi + 1).Name & ".xls", Password:=Trim(.Cells(xi, "B")), WriteResPassword:="", FileFormat:=xlExcel8
  19.             '   ActiveWorkbook.SaveAs Filename:=xPath & Wb.Sheets(xi + 1).Name & ".xlsx", Password:=Trim(.Cells(xi, "B")), WriteResPassword:="", FileFormat:=xlWorkbookDefault

  21.             ActiveWorkbook.Close False     '  關閉 "D:\A123.xls" 活頁簿、"D:\B456.xls" 活頁簿。
  22.         Next
  23.     End With
  24. End Sub
複製代碼
在 Hsieh 版大的程式碼中，GBKEE 增加了 Wb 的加強宣告，明確地指出活頁簿的屬性歸屬。
  1. Sub Ex2()            '  Hsieh & GBKEE
  2.     Dim f$, fd$, fs$, A As Range, Wb As Workbook
  3.    
  4.     Set Wb = ThisWorkbook             '  活頁簿 :程式碼所在的
  5.     fd = Wb.Path & "\"                       '  存檔的路徑
  6.     With Wb.Sheets("PASSWORD")
  7.         For Each A In .Range(.[A1], .[A1].End(xlDown))
  8.             '  A                                   : "A123" : Range/Range
  9.             '  A                                   : "B456" : Range/Range
  10.             '  Sheets("PASSWORD").[A1]             : "A123" : Variant/Object/Range
  11.             '  Sheets("PASSWORD").[A1].End(xlDown) : "B456" : Variant/Object/Range
  12.             f = CStr(A)
  13.             fs = fd & f & ".xls"
  14.             Wb.Sheets(f).Copy      '  指定是哪一個活頁簿的工作表要複製
  15.             '  Sheets(f).Copy 執行過後，複製了一活頁簿，內有一名為 "A123" 之工作表單。
  16.             '  ActiveWorkbook.Name           : "活頁簿1" : String
  17.             '  ActiveWorkbook.Sheets(1).Name : "A123"    : Variant/String
  18.             '  Sheets(f).Copy 執行過後，複製了一活頁簿，內有一名為 "B456" 之工作表單。
  19.             '  ActiveWorkbook.Name           : "活頁簿2" : String
  20.             '  ActiveWorkbook.Sheets(1).Name : "B456"    : Variant/String
  21.             With ActiveWorkbook
  22.                 .ActiveSheet.UsedRange = .ActiveSheet.UsedRange.Value
  23.                 '  FileFormat:=xlExcel8   Excel 2003版本 56; xlExcel12  version 12, or 14, or 15 = Excel 2007, or 2010, or 2013.
  24.                 .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:="", FileFormat:=xlExcel8
  25.                 .Close 0       '  關閉 "D:\A123.xls" 活頁簿、"D:\B456.xls" 活頁簿。
  26.             End With           '  正式結束 (關閉)。
  27.         Next
  28.     End With
  29. End Sub
複製代碼
作者: Hsieh    時間: 2013-11-28 09:36

回復 6# missbb
程式碼只要是放在此檔案內，同一個EXCEL專案並無其他開啟的檔案
不需指定此活頁簿也應該可以執行
會出錯可能A欄的工作表名稱與要COPY的工作表名稱不符，但此類錯誤應該產生超出陣列索引錯誤
建議將你的檔案上傳，比較能夠了解錯誤點
作者: missbb    時間: 2013-11-30 17:41

回復 10# Hsieh

其實我想上傳RAR或ZIP檔問多一點, 但每次點選檔案後, 按"上傳"鍵都沒有反應, 是甚麼原因呢?

很苦惱:dizzy:
作者: Hsieh    時間: 2013-12-2 15:16

回復 11# missbb


    [attach]16926[/attach]
作者: missbb    時間: 2013-12-29 16:09

回復 9# c_c_lai

您好, 現在才有時間測試.  是可以另存新檔案, 但原有程式未能以值顯示, 全部是#VALUE ?

請問 Dim f$, fd$, fs$, ...當中f 是指定碼還是任何英文字也可代替?
另如SHEET :PASSWORD 　內的Ａ１２３ＰＡＳＳＷＯＲＤ　由第二ＲＯＷ起，　程式碼有沒有改變？（我試過將第１ＲＯＷ加上ＨＥＡＤＩＮＧ，　有點問題）

有勞大大。

另外我不知何解，　我始終不能上載檔案，　我的畫面與大大的顯示有不同。
作者: c_c_lai    時間: 2013-12-29 20:53

回復 13# missbb
我用圖表說明，妳便會明瞭了。
首先妳先新增一個工作表單，假設名稱為 "多張工作表另存活頁簿及抓住預設密碼"
或任一名稱、或者為 "Test"。
然後如附件圖表一樣，建立三個工作表單：PASSWORD、A123、B456。
接著再把 9# 的程式碼複製於 ThisWorkbook 內 (如圖示)。
[attach]17147[/attach]
[attach]17148[/attach]
作者: c_c_lai    時間: 2013-12-29 20:55

本帖最後由 c_c_lai 於 2013-12-29 20:58 編輯

回復 13# missbb
[attach]17149[/attach]
[attach]17150[/attach]
妳可以從 HSIEH、GBKEE 兩位版大的程式碼中瞭解
它是如何執行的，況且我也在程式碼加上了註釋。
作者: c_c_lai    時間: 2013-12-29 21:08

回復 13# missbb
忘了說明， Ex() 所產生的 A123、B456 兩個檔名之 Extension Name 為 .xlsx；
Ex2() 所產生的 A123、B456 兩個檔名之 Extension Name 為 .xls。
此是為了要讓妳了解如何產生 .xlsx 或者 .xls，在語法上如何應用而已。
記得、主檔之 Extension Name 應儲存為 .xls (2003) 、或儲存為 .xlsm (2007、2010)。
作者: missbb    時間: 2013-12-29 21:36

回復 16# c_c_lai

您好, 我用了下述程序都獨立儲存A123, B456是沒有問題的.
但因為我在PASSWORD SHEET內加了些資料, 讓A123, B456以VLOOKUP取資料, 不知是否這原因, 新開的A123檔案及B456檔案內, VLOOKUP的資料都變成了結#VALUE. 有方法解決嗎?

  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(.[A2], .[A2].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
作者: c_c_lai    時間: 2013-12-29 21:44

回復 17# missbb
妳將你的檔案壓縮成  .zip (WinZip.exe) 、 或 .rar (WinRar.exe) 的檔案
使用 IE 上傳，否則難以知悉妳的問題。
作者: missbb    時間: 2013-12-29 22:01

回復 18# c_c_lai
好的, 明白上班試上傳, 因我家裡的電腦做不到.

麻煩您.
作者: missbb    時間: 2013-12-30 21:22     標題: RE: 多張工作表另存活頁簿及抓住預設密碼

回復 19# missbb
作者: missbb    時間: 2013-12-31 22:03

[attach]17174[/attach]回復 19# missbb
已上傳, 麻煩查看.
作者: missbb    時間: 2013-12-31 22:07

回復 18# c_c_lai
您好, 我上傳了, 但貼在第3頁內, 有勞查看.
作者: c_c_lai    時間: 2014-1-1 09:08

本帖最後由 c_c_lai 於 2014-1-1 09:10 編輯

回復 22# missbb
你的問題發生於 "B5" 欄位上
  1. =MID(CELL("filename",A1),FIND("]",CELL("filename",A1),1)+1,31)
複製代碼
我不太瞭解妳 公式 的含意 (不好意思)。
如果妳將 B5 欄位直接打入 A123、A124、B456 然後再重新執行一遍，
就不會有妳所謂的困擾問題，因為所有有數值欄位的內容公式均與 B5 欄有關之故。
作者: GBKEE    時間: 2014-1-1 09:53

本帖最後由 GBKEE 於 2014-1-1 10:15 編輯

回復 22# missbb
  1. Option Explicit
  2. Sub Ex2()            '  Hsieh & GBKEE
  3.     Dim f$, fd$, fs$, A As Range, Wb As Workbook, AR()
  4.     Set Wb = ThisWorkbook             '  活頁簿 :程式碼所在的
  5.     fd = Wb.Path & "\"                       '  存檔的路徑
  6.     Application.DisplayAlerts = False
  7.     Application.ScreenUpdating = False
  8.     With Wb.Sheets("PASSWORD")
  9.         For Each A In .Range(.[A2], .[A2].End(xlDown))
  10.             f = CStr(A)
  11.             fs = fd & f & ".xls"
  12.             AR = Wb.Sheets(f).UsedRange.Value
  13.             With Workbooks.Add(1)
  14.                 .ActiveSheet.Range("A1").Resize(UBound(AR, 1), UBound(AR, 2)) = AR
  15.                 '  FileFormat:=xlExcel8   Excel 2003版本 56; xlExcel12  version 12, or 14, or 15 = Excel 2007, or 2010, or 2013.
  16.                
  17.                 .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:="" , FileFormat:=xlExcel8
  18.                 .Close 0       '  關閉 "D:\A123.xls" 活頁簿、"D:\B456.xls" 活頁簿。
  19.             End With           '  正式結束 (關閉)。
  20.         Next
  21.     End With
  22.     Application.DisplayAlerts = True
  23.     Application.ScreenUpdating = True
  24. End Sub
複製代碼
作者: missbb    時間: 2014-1-1 10:03

回復 23# c_c_lai

是這樣的.
我首先在PASSWORD SHEET內打入所有資料 -> 再為每一個員工編號開SHEET, 在每張SHEET內B5 內以程式得SHEET 名稱->再用VLOOKUP 憑SHEET名稱取PASSWORD SHEET 內資料->再執行VBA以每一個SHEET另存新檔.
作者: missbb    時間: 2014-1-1 10:13

回復 24# GBKEE

您好, 已試驗是可行的.  但開啟另存之A124檔時, 出現:您正在試開啟A124.xls, 其檔案格式與副檔名所指定的格式不同, 開啟前請確定檔案未損毀, 且來自信心的來源, 您現在開啟嗎?"

未知有何不妥的地方, 請賜教!
作者: GBKEE    時間: 2014-1-1 10:23

回復 26# missbb
2003測試 需註解FileFormat:=xlExcel8
已更正 取消註解 ' FileFormat:=xlExcel8
作者: c_c_lai    時間: 2014-1-1 10:38

回復 24# GBKEE
謝謝您幫我解惑！
新年快樂，身體健康，心想事成。
作者: c_c_lai    時間: 2014-1-1 10:40

回復 26# missbb
GBKEE 已經解決了妳的提問。
除歲佈新，新年快樂！
作者: c_c_lai    時間: 2014-1-1 11:14

回復 25# missbb
終於看懂妳所布局的公式了，謝謝妳！
作者: missbb    時間: 2014-1-1 19:21

回復 30# c_c_lai

感激所有協助的大大, 新年快樂.
作者: missbb    時間: 2014-1-1 20:04

回復 27# GBKEE

再請問如果想每個SHEET都加入統一的保護工作表密碼(避免使用者更改, 使用者但可以另存新檔或列印), 我看到有下列:
activeworkbook.protect password:"9999",structure:=true,windows:=true

請問應放在如有VBA碼內那個位置?
作者: GBKEE    時間: 2014-1-2 07:40

回復 32# missbb
只要你認為活頁簿尚未保護時都可用的
  1. '保護活頁簿使其不被修改。
  2. ActiveWorkbook.Protect Password:="9999", structure:=True, Windows:=True
複製代碼
作者: missbb    時間: 2014-1-3 23:06

回復 33# GBKEE


    [attach]17195[/attach]

大大好, 又有新困難.
(1)我將ACTIVATEWORKBOOK PROTECT放入, 另存新檔開啟後久久不能關閉. 我是想保護內容不被使用者更改, 但又發覺可以改.
(2) 現在可以貼上值, 但請問如何可以將格線及欄寬及數字格式一併另存新檔?

有勞賜教.
作者: missbb    時間: 2014-1-4 16:27

[attach]17196[/attach]回復 33# GBKEE

不好意思, 已解除密碼.

:L
作者: GBKEE    時間: 2014-1-4 17:46

本帖最後由 GBKEE 於 2014-1-4 19:37 編輯

回復 35# missbb
  1. Option Explicit
  2. Sub Ex2()
  3.     Dim f$, fd$, fs$, A As Range, Wb As Workbook
  4.     Set Wb = ThisWorkbook             '  活頁簿 :程式碼所在的
  5.     fd = Wb.Path & "\"                       '  存檔的路徑
  6.     Application.DisplayAlerts = False
  7.     Application.ScreenUpdating = False
  8.     With Wb.Sheets("PASSWORD")
  9.         For Each A In .Range(.[A2], .[A2].End(xlDown))
  10.             f = CStr(A)
  11.             fs = fd & f & ".xls"
  12.             Wb.Sheets(f).UsedRange.Copy  '用COPY
  13.             With Workbooks.Add(1)
  14.                 With .Sheets(1).Range("A1")
  15.                     .PasteSpecial xlPasteValues           '貼上值
  16.                     .PasteSpecial xlPasteColumnWidths     '貼上欄寬
  17.                     .PasteSpecial xlPasteFormats          '貼上格式
  18.                     '第一重:保護工作表
  19.                     .Parent.Protect Password:="9999", DrawingObjects:=True, Contents:=True, Scenarios:=True
  20.                 End With
  21.                 '第二重:保護活頁簿使其structure(結構:工作表不可刪增)。
  22.                 .Protect Password:="9999", structure:=True, Windows:=False
  23.                 '  FileFormat:=xlExcel8   Excel 2003版本 56; xlExcel12  version 12, or 14, or 15 = Excel 2007, or 2010, or 2013.
  24.                 '第三重: 限制使用者
  25.                 .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:=""   , FileFormat:=xlExcel8
  26.                 .Close 0   '  關閉  "D:\A123.xls" 活頁簿、"D:\B456.xls" 活頁簿。
  27.             End With           '  正式結束 (關閉)。
  28.         Next
  29.     End With
  30.     Application.DisplayAlerts = True
  31.     Application.ScreenUpdating = True
  32. End Sub
複製代碼
作者: missbb    時間: 2014-1-4 18:55

回復 36# GBKEE

大大您好, 執行時出現"執行階段錯誤'429', ACTIVEX元件無法產生物件", 請幫忙!:funk:
作者: op12345677    時間: 2015-12-6 05:31

謝謝 學習到很多 對VB新手的我來說



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)