mark15jill

回復  mark15jill


    ㄜ ........

慚愧..................................前輩,what a ...
kaohsiung-man 發表於 2013-4-22 15:32

    簡單來說

Private Sub Worksheet_SelectionChange(ByVal Target As Range)   ..... End Sub   <== 好比自然界的自然風，不用做任何動作就會有 風 流動
Sub kka  .... End Sub  <== 好比電風扇，需要有按下開關，才會有風

GBKEE

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

複製代碼

kaohsiung-man

回復 11# mark15jill


   {:3_55:} 在下愚鈍~~~

測試之下....似乎不用以password"123"解除保護~~直接 工具>保護>取消保護工作表 即可解鎖了...
但小的需要的是"將指定儲存格輸入數值後,該儲存格自動上鎖,並可以password解鎖".

還請前輩明示....謝謝!

kaohsiung-man

回復 12# GBKEE


        超版大~~

小的需要將"指定儲存格(使用中儲存格)輸入數值後,該儲存格自動上鎖,並可以password解鎖",
並不需要連工作表也一同上鎖~

就原6# 程式碼,該如何修正方能符合上述需求呢?

敬請指教 ... 謝謝!

GBKEE

回復 14# kaohsiung-man
並不需要連工作表也一同上鎖
工作表上鎖的條件下: 儲存格才可上鎖

kaohsiung-man

回復 15# GBKEE

超版大~~

    若就7# 的程式碼....又該如何將"工作表加上有password的鎖"的呢?

    因為程式碼中的"123"似乎沒有效用...只要 工具>保護>取消保護工作表 即可解鎖了!

敬請指教 ... 謝謝!

kaohsiung-man

回復 12# GBKEE

{:3_46:} 感謝前輩...小的再以"保護"加以設定~~即可!

謝謝!{:3_59:}

kaohsiung-man

回復 9# mark15jill


    感謝前輩...小的再以"保護"加以設定~~即可!

謝謝!

GBKEE

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

複製代碼

die78325

回復 18# kaohsiung-man


    是否可貼您修改後的語法?  我也想學習您的方法@@" 感謝