返回列表 上一主題 發帖

[解決了，改為分享] 用VBA批次幫其他excel 的VB專案設定密碼鎖定

diabo

帖子
79 
主題
2 
精華
0 
積分
193 
點名
0  
作業系統
Winwos 7 64 bits 
軟體版本
Excel 2003/2007 
閱讀權限
20 
性別
男 
來自
TAIPEI 
註冊時間
2010-8-25 
最後登錄
2019-9-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-2-26 20:55 | 只看該作者

[解決了，改為分享] 用VBA批次幫其他excel 的VB專案設定密碼鎖定

本帖最後由 diabo 於 2011-2-28 00:31 編輯

一直無法成功，請大家幫忙看看哪裡有問題？
  1. Sub Lock_VBA()

  3.     Dim xlapp As Excel.Application
  4.     Dim wbSource As Excel.Workbook
  5.     Dim LogFileName As Variant
  6.     Dim fname As Variant
  7.     Dim VBA_PWD As String, XLS_PWD As String
  8.    
  9.    '取得密碼
  10.     VBA_PWD = [c4]  'VBA password
  11.    
  12.     Set xlapp = New Excel.Application
  13.    
  14.    'MultiSelect:=True 表示可複選檔案
  15.     LogFileName = Application.GetOpenFilename( _
  16.             FileFilter:="Excel檔(*.xls),*.txt", _
  17.             Title:="請選取檔案", MultiSelect:=True)
  18.    
  19.    '判斷使用者是否有選取檔案，或按取消
  20.     If VarType(LogFileName) = vbBoolean Then
  21.         Exit Sub
  22.     End If
  23.    
  24.    

  26.     xlapp.Visible = True

  28.     For Each fname In LogFileName
  29.         Set wbSource = xlapp.Workbooks.Open(CStr(fname))
  30.         
  31.        '專案沒有保護
  32.         If wbSource.VBProject.Protection = 0 Then
  33.             
  34.             DoEvents
  35.             
  36.             With xlapp
  37.                 .SendKeys "%{F11}"                'Alt + F11 切換到VBA視窗
  38.                 .SendKeys "%Te"                    'ALT + T 工具(繁體中文是(T))-VBproject屬性(E)
  39.                 .SendKeys "^{TAB}"                '切換到下一頁面 VBproject屬性(E)-保護
  40.                 .SendKeys "{+}"                   '{+}/{-}選取/取消「鎖定專案以供檢視」
  41.                 .SendKeys "{TAB}", False          '移到密碼欄位
  42.                 .SendKeys VBA_PWD & "{TAB}", True '輸入密碼
  43.                 .SendKeys VBA_PWD                 '確認密碼
  44.                 .SendKeys "{TAB}{ENTER}"          '按確定鈕(預設值)
  45.                 .SendKeys "%q"                    '
  46.             End With
  47.             
  48.            '存檔後關閉該檔案
  49.             wbSource.Save
  50.             wbSource.Close SaveChanges:=True
  51.             
  52.            'MsgBox Dir(fname) & " 專案鎖定完成"
  53.             
  54.         Else
  55.            
  56.            '不存檔後關閉該檔案
  57.             wbSource.Close SaveChanges:=False
  58.            
  59.            'MsgBox Dir(fname) & " 專案已經鎖定，請解鎖後再執行"
  60.         End If

  62.     Next fname
  63.    
  64.     Set wbSource = Nothing     xlapp.Quit

  66. End Sub
複製代碼
lock_vba.rar (493.61 KB)
收藏 分享
diabo

kimbal

帖子
472 
主題
5 
精華
0 
積分
485 
點名
0  
作業系統
Windows 
軟體版本
MS Office 
閱讀權限
100 
性別
男 
來自
香港 
註冊時間
2010-7-4 
最後登錄
2014-12-28 

論壇貢獻勳章
2#
發表於 2011-2-27 10:41 | 只看該作者
一直無法成功，請大家幫忙看看哪裡有問題？
diabo 發表於 2011-2-26 20:55


sendkeys需要配合版面顯示快速度,試試加些暫停的代碼
  1.                With xlapp
  2.                 .SendKeys "%{F11}"                'Alt + F11 切換到VBA視窗
  3.                 Application.Wait (Now + TimeValue("0:00:01"))
  4.                 .SendKeys "%Te"                    'ALT + T 工具(繁體中文是(T))-VBproject屬性(E)
  5.                 Application.Wait (Now + TimeValue("0:00:01"))
  6.                 .SendKeys "^{TAB}"                '切換到下一頁面 VBproject屬性(E)-保護
  7.                 Application.Wait (Now + TimeValue("0:00:01"))
  8.                 .SendKeys "{+}"                   '{+}/{-}選取/取消「鎖定專案以供檢視」
  9.                 Application.Wait (Now + TimeValue("0:00:01"))
  10.                 .SendKeys "{TAB}", False          '移到密碼欄位
  11.                 Application.Wait (Now + TimeValue("0:00:01"))
  12.                 .SendKeys VBA_PWD & "{TAB}", True '輸入密碼
  13.                 Application.Wait (Now + TimeValue("0:00:01"))
  14.                 .SendKeys VBA_PWD                 '確認密碼
  15.                 Application.Wait (Now + TimeValue("0:00:01"))
  16.                 .SendKeys "{TAB}{ENTER}"          '按確定鈕(預設值)
  17.                 Application.Wait (Now + TimeValue("0:00:01"))
  18.                 .SendKeys "%q"                    '
  19.             End With
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

diabo

帖子
79 
主題
2 
精華
0 
積分
193 
點名
0  
作業系統
Winwos 7 64 bits 
軟體版本
Excel 2003/2007 
閱讀權限
20 
性別
男 
來自
TAIPEI 
註冊時間
2010-8-25 
最後登錄
2019-9-20 
3#
發表於 2011-2-28 00:30 | 只看該作者
謝謝 kimbal ，果然是這要命的8秒.......

現在 OK 了....
diabo

TOP

        靜思自在 : 君子立恆志，小人恆立志。
返回列表 上一主題