麻辣家族討論版版 - Powered by Discuz! Board

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

作者: kaohsiung-man 時間: 2013-4-20 11:34 標題: 這到底該發在那ㄚ?...怎麼做?當儲存格輸入數值後,該儲存格即自動上鎖.謝謝!

我是小呆~~這到底該發在那ㄚ???

如題------怎麼做?...當儲存格輸入數值後,該儲存格即自動上鎖.~~THANKS!

當我在sheet1中,某個儲存格輸入數值後,希望該儲存格可馬上"自動上鎖"....該怎麼做呢?

若要寫excel vba .....請高手們提供程式碼,救救電腦小呆吧!

作者: mark15jill 時間: 2013-4-22 08:19

我是小呆~~這到底該發在那ㄚ???

如題------怎麼做?...當儲存格輸入數值後,該儲存格即自動上鎖.~~THANKS! ...
kaohsiung-man 發表於 2013-4-20 11:34

馬上上鎖的定義為何？隱藏？跳開？還是？

作者: kaohsiung-man 時間: 2013-4-22 08:34

回復 2# mark15jill

我是小呆~~ , 是的~~~~前輩!

可馬上"自動上鎖"的意思就是........對輸入數值的該儲存格,在鍵入數值按enter後,該儲存格即可被自動上鎖,而無法再進行更改!
並不是隱藏或跳出!!!

有尋獲...在sheet1中,某個儲存格輸入數值後,該工作頁隨即自動上鎖,而無法再進行更改!
但小弟需要的是...自動上鎖該儲存格,而非整個工作頁~~

若要寫excel vba .....請高手們提供程式碼,救救電腦小呆吧!

作者: mark15jill 時間: 2013-4-22 10:27

回復 mark15jill

我是小呆~~ , 是的~~~~前輩!

可馬上"自動上鎖"的意思就是........對輸入數值的 ...
kaohsiung-man 發表於 2013-4-22 08:34

以下程式碼可做到... 但是... 是大範圍的，請自行修改

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.Unprotect
ActiveSheet.Cells.Locked = False
Dim Rng As Range
ActiveSheet.Unprotect
For Each Rng In ActiveSheet.UsedRange
If Rng.Value <> "" Or Rng.HasFormula Then Rng.Locked = True
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

複製代碼

作者: kaohsiung-man 時間: 2013-4-22 13:25

本帖最後由 kaohsiung-man 於 2013-4-22 13:27 編輯

回復 4# mark15jill

.....太感激您ㄌ~~~

但是~~~上鎖了....小的該怎麼解鎖...可否在程式碼中加入解鎖密碼呢?

而且,若是只要鎖定A1~C10及F1~H10即可...又該從何處修改呢?

謝謝前輩

作者: kaohsiung-man 時間: 2013-4-22 13:38

回復 4# mark15jill
這是小呆寫的劣作...該如何與您的程式碼結合成:
1.當儲存格輸入數值後,該儲存格即自動上鎖.
2.附有解鎖password.
3.僅對A1~C10及F1~H10儲存格作自動上鎖的設定.
盼您不吝指教 ~ 謝謝 !

Private Sub Worksheet_Change(ByVal Target As Range)
'Automatically Protecting After Input
'unlock all cells in the range first
Dim MyRange As Range
Const Password = "123" '**Change password here**
Set MyRange = Intersect(Range("A1:C10，F1:H10"), Target) '**change range here**
If Not MyRange Is Nothing Then
Unprotect Password:=Password
MyRange.Locked = True
Protect Password:=Password
End If
End Sub

作者: mark15jill 時間: 2013-4-22 14:22

本帖最後由 mark15jill 於 2013-4-22 14:24 編輯

有洗帖的嫌疑....<6#>

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.Unprotect
ActiveSheet.Cells.Locked = False
Dim Rng1,Rng2 As Range
ActiveSheet.Unprotect
'第一個封鎖區域
For Each Rng1 In Range("A1:C10") '這改範圍
If Rng1.Value <> "" Or Rng1.HasFormula Then Rng1.Locked = True
If [x1] = "123" Then Rng1.Locked = False '設定解除條件
Next
'第二個封鎖區域
For Each Rng2 In Range("F1:H10") '這改範圍
If Rng2.Value <> "" Or Rng2.HasFormula Then Rng2.Locked = True
If [x1] = "123" Then Rng2.Locked = False'設定解除條件
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

複製代碼

作者: kaohsiung-man 時間: 2013-4-22 15:04

回復 8# mark15jill
SORRY....#6 ->手按快了啦...

不過...結合的方式,實非小的所能想像~~~

只能說學藝不精,粗淺僅得皮毛

......................................................................

方才測試....似乎不用以password解除保護~~直接工具>保護>取消保護工作表即可解鎖了...

前輩,請查照....謝謝!

作者: mark15jill 時間: 2013-4-22 15:10

本帖最後由 mark15jill 於 2013-4-22 15:12 編輯

回復 mark15jill
SORRY....#6 ->手按快了啦...

不過...結合的方式,實非小的所能想 ...
kaohsiung-man 發表於 2013-4-22 15:04

之所以用
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ..... End Sub
不同於
Sub kka .... End Sub

前者
就是只要有變動<不管是滑鼠點擊或儲存格變動>，就會按照程式去跑..除非把巨集功能關掉

後者
要執行後，功能才會啟動....

但是
只要將巨集功能關掉或另外設定... 這一切都沒用ˇˇ

作者: kaohsiung-man 時間: 2013-4-22 15:32

回復 10# mark15jill

ㄜ ........

慚愧..................................前輩,what are U talking about ???

小的 ...不懂...

作者: mark15jill 時間: 2013-4-22 16:09

回復 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 時間: 2013-4-22 16:30

回復 11# mark15jill
樓主1# 說: 當儲存格輸入數值後,該儲存格即自動上鎖
修改樓主6# 程式碼

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) '儲存格有異動(Target) 工作表預設事件
'Automatically Protecting After Input
'unlock all cells in the range first
Dim MyRange As Range
Const Password = "123" '**Change password here** 工作表上鎖的密碼
'ActiveCell:使用中儲存格
Set MyRange = Intersect(Range("A1:C10，F1:H10"), ActiveCell) '**change range here**
'Set MyRange = Intersect(Range("A1:C10，F1:H10"), Target(1)) '用Target(1)也可以
If Not MyRange Is Nothing Then '是在->"A1:C10，F1:H10"
Unprotect Password:=Password '工作表解鎖
''MyRange.Locked = True '"A1:C10，F1:H10" 儲存格上鎖
'****************************************************
'樓主的問題:當儲存格輸入數值後,該儲存格即自動上鎖'
ActiveCell.Locked = True '使用中儲存格上鎖
'*************************************************
Protect Password:=Password '工作表上鎖
End If
End Sub

複製代碼

作者: kaohsiung-man 時間: 2013-4-22 17:39

回復 11# mark15jill

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

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

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

作者: kaohsiung-man 時間: 2013-4-22 17:45

回復 12# GBKEE

超版大~~

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

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

敬請指教 ... 謝謝!

作者: GBKEE 時間: 2013-4-22 17:47

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

作者: kaohsiung-man 時間: 2013-4-22 18:57

回復 15# GBKEE

超版大~~

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

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

敬請指教 ... 謝謝!

作者: kaohsiung-man 時間: 2013-4-23 08:49

回復 12# GBKEE

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

謝謝!{:3_59:}

作者: kaohsiung-man 時間: 2013-4-23 08:50

回復 9# mark15jill

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

謝謝!

作者: GBKEE 時間: 2013-5-9 09:41

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

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

複製好程式碼請先存檔後在開檔試試
範例適用於: 工作表[Sheet1] 儲存格輸入數值後,該儲存格即自動上鎖

Option Explicit
'ThisWorkbook模組
Private Sub Workbook_Activate() '活頁簿觸動事件 : '活頁簿成為使用中的活頁簿
貼上功能 False
Workbook_Open
End Sub
Private Sub Workbook_Deactivate() '活頁簿觸動事件 : '活頁簿不是使用中的活頁簿
貼上功能 True
End Sub
Private Sub Workbook_Open() '活頁簿觸動事件 : 檔案開啟自動執行的程式
With Sheets("Sheet1")
.AR = .Range(.Cells(1), .UsedRange) '
'工作表[Sheet1]: 所有資料置於陣列
End With
貼上功能 False
End Sub
Private Sub 貼上功能(M As Boolean) 'M=True : 可用貼上功能指令, M = False: 禁用貼上功能指令
Dim C As CommandBar, W As CommandBarControl, E As CommandBarControl
On Error Resume Next
For Each C In Application.CommandBars
For Each W In C.Controls
For Each E In W.Controls
If E.Caption Like "*貼上*" Then E.Enabled = M
Next
If W.Caption Like "*貼上*" Then W.Enabled = M
Next
Next
End Sub

複製代碼

'工作表模組的預設程序觸動事件
Option Explicit
Public AR '工作表模組可供其他模組之程序使用的變數
Private Sub Worksheet_Change(ByVal Target As Range) '工作表觸動事件: 工作表內容有變動
Dim A '本程序使用的變數
Application.EnableEvents = False
If IsArray(AR) Then
If Target.Row <= UBound(AR, 1) And Target.Column <= UBound(AR, 2) Then
A = AR(Target.Row, Target.Column)
If IsNumeric(A) And A <> "" Then Target = A
End If
End If
Application.EnableEvents = True
AR = Range(Cells(1), UsedRange)
'ThisWorkbook.Save '存檔
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '工作表觸動事件: 工作表使用中的儲存格範圍變動
If Target.Count > 1 Then
Target(1).Select
MsgBox "不允許你選擇多個儲存格 !!! "
'預防清除所有資料
End If
End Sub

複製代碼

作者: die78325 時間: 2013-5-9 16:47

回復 18# kaohsiung-man

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

作者: ML089 時間: 2013-5-19 18:49

回復 19# GBKEE

像這類的程式是怕作業階層使用人去亂修改資料，
剛好我也想寫一個EXCEL上下班打卡鐘程式，也可用此觀念。

若管理階層要修改資料不知要如何處理?
後來我關閉EXCEL再重新開啟時，我選擇 "停用巨集" 就可以修改。這樣的保護有點薄弱。
有沒有開啟一定會執行巨集的方法，或其他保護方式?

作者: GBKEE 時間: 2013-5-20 08:31

回復 21# ML089

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

[attach]15030[/attach]

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