Board logo

標題: [解決了，改為分享] 用VBA批次幫其他excel 的VB專案設定密碼鎖定 [打印本頁]
作者: diabo    時間: 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
複製代碼
[attach]4878[/attach]
作者: kimbal    時間: 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
複製代碼
作者: diabo    時間: 2011-2-28 00:30

謝謝 kimbal ，果然是這要命的8秒.......

現在 OK 了....



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