返回列表 上一主題 發帖

[發問] 這到底該發在那ㄚ?...怎麼做?當儲存格輸入數值後,該儲存格即自動上鎖.謝謝!

回復 11# mark15jill
樓主1# 說: 當儲存格輸入數值後,該儲存格即自動上鎖
修改樓主6# 程式碼
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range) '儲存格有異動(Target) 工作表預設事件
  3.     'Automatically Protecting After Input
  4.     'unlock all cells in the range first
  5.     Dim MyRange As Range
  6.     Const Password = "123" '**Change password here** 工作表上鎖的密碼
  7.     'ActiveCell:使用中儲存格
  8.     Set MyRange = Intersect(Range("A1:C10,F1:H10"), ActiveCell) '**change range here**
  9.     'Set MyRange = Intersect(Range("A1:C10,F1:H10"), Target(1)) '用Target(1)也可以
  10.     If Not MyRange Is Nothing Then '是在->"A1:C10,F1:H10"
  11.         Unprotect Password:=Password        '工作表解鎖
  12.         ''MyRange.Locked = True             '"A1:C10,F1:H10" 儲存格上鎖
  13.    '****************************************************  
  14.    '樓主的問題:當儲存格輸入數值後,該儲存格即自動上鎖'
  15.         ActiveCell.Locked = True            '使用中儲存格 上鎖
  16.    '*************************************************
  17.         Protect Password:=Password          '工作表上鎖
  18.     End If
  19. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 14# kaohsiung-man
並不需要連工作表也一同上鎖
工作表上鎖的條件下: 儲存格才可上鎖
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-5-9 12:35 編輯

回復 18# kaohsiung-man
15# 工作表上鎖的條件下: 儲存格才可上鎖
我這觀念可能有些錯誤!!

複製好程式碼 請先存檔 後在開檔試試
範例適用於: 工作表[Sheet1]  儲存格輸入數值後,該儲存格即自動上鎖
  1. Option Explicit
  2. 'ThisWorkbook模組
  3. Private Sub Workbook_Activate()    '活頁簿觸動事件 : '活頁簿成為使用中的活頁簿
  4.     貼上功能 False
  5.     Workbook_Open
  6. End Sub
  7. Private Sub Workbook_Deactivate() '活頁簿觸動事件 :  '活頁簿不是使用中的活頁簿
  8.     貼上功能 True
  9. End Sub
  10. Private Sub Workbook_Open()         '活頁簿觸動事件 : 檔案開啟自動執行的程式
  11.     With Sheets("Sheet1")
  12.         .AR = .Range(.Cells(1), .UsedRange)  '
  13.         '工作表[Sheet1]: 所有資料置於陣列
  14.     End With
  15.     貼上功能 False
  16. End Sub
  17. Private Sub 貼上功能(M As Boolean)  'M=True : 可用貼上功能指令,   M = False: 禁用貼上功能指令
  18.     Dim C As CommandBar, W As CommandBarControl, E As CommandBarControl
  19.     On Error Resume Next
  20.     For Each C In Application.CommandBars
  21.             For Each W In C.Controls
  22.                 For Each E In W.Controls
  23.                     If E.Caption Like "*貼上*" Then E.Enabled = M
  24.                 Next
  25.                  If W.Caption Like "*貼上*" Then W.Enabled = M
  26.             Next
  27.     Next
  28. End Sub
複製代碼
  1. '工作表模組的預設程序 觸動事件
  2. Option Explicit
  3. Public AR '工作表模組 可供其他模組之程序使用的變數
  4. Private Sub Worksheet_Change(ByVal Target As Range) '工作表觸動事件: 工作表內容有變動
  5. Dim A      '本程序使用的變數
  6. Application.EnableEvents = False
  7. If IsArray(AR) Then
  8. If Target.Row <= UBound(AR, 1) And Target.Column <= UBound(AR, 2) Then
  9. A = AR(Target.Row, Target.Column)
  10. If IsNumeric(A) And A <> "" Then Target = A
  11. End If
  12. End If
  13. Application.EnableEvents = True
  14. AR = Range(Cells(1), UsedRange)
  15. 'ThisWorkbook.Save '存檔
  16. End Sub
  17. Private Sub Worksheet_SelectionChange(ByVal Target As Range) '工作表觸動事件: 工作表使用中的儲存格範圍變動
  18. If Target.Count > 1 Then
  19. Target(1).Select
  20. MsgBox "不允許 你選擇多個儲存格 !!! "
  21. '預防 清除所有資料
  22. End If
  23. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 21# ML089

"停用巨集" 還是可以 執行巨集 參考這裡
Excel 設定 "停用巨集" 後下載附檔試試看

test.zip (10.78 KB)
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人生不一定球球是好球,但是有歷練的強打者,隨時都可以揮棒。
返回列表 上一主題