[發問] 多張工作表另存活頁簿及抓住預設密碼

missbb

[發問] 多張工作表另存活頁簿及抓住預設密碼
各位專家
本人正學習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內的成為活頁簿密碼, 並只存文字的值及格式

有労賜教!

op12345677

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

missbb

回復 36# GBKEE

大大您好, 執行時出現"執行階段錯誤'429', ACTIVEX元件無法產生物件", 請幫忙!:funk:

GBKEE

回復 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

payas2.zip (16.14 KB)

下載次數: 7

2014-1-4 16:26

回復 33# GBKEE

不好意思, 已解除密碼.

:L

missbb

回復 33# GBKEE


    payas.rar (35.22 KB)

下載次數: 5

2014-1-3 23:03

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

有勞賜教.

GBKEE

回復 32# missbb
只要你認為活頁簿尚未保護時都可用的

1. '保護活頁簿使其不被修改。
   
2. ActiveWorkbook.Protect Password:="9999", structure:=True, Windows:=True

複製代碼

missbb

回復 27# GBKEE

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

請問應放在如有VBA碼內那個位置?

missbb

回復 30# c_c_lai

感激所有協助的大大, 新年快樂.

c_c_lai

回復 25# missbb
終於看懂妳所布局的公式了，謝謝妳！