這到底該發在那ㄚ?...怎麼做?當儲存格輸入數值後,該儲存格即自動上鎖.謝謝! - Excel程式區

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: xp
軟體版本: 1
閱讀權限: 10
性別: 男
註冊時間: 2013-4-20
最後登錄: 2013-4-23

13^# 跳轉到 »

發表於 2013-4-22 17:39 | 只看該作者

回復 11# mark15jill

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

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

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

12^#

發表於 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

複製代碼

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

TOP

mark15jill

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

11^#

發表於 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 <== 好比電風扇，需要有按下開關，才會有風

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

kaohsiung-man

小學生 Rank: 1

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: xp
軟體版本: 1
閱讀權限: 10
性別: 男
註冊時間: 2013-4-20
最後登錄: 2013-4-23

10^#

發表於 2013-4-22 15:32 | 只看該作者

回復 10# mark15jill

ㄜ ........

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

小的 ...不懂...

TOP

mark15jill

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

9^#

發表於 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

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

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

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

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

kaohsiung-man

小學生 Rank: 1

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: xp
軟體版本: 1
閱讀權限: 10
性別: 男
註冊時間: 2013-4-20
最後登錄: 2013-4-23

8^#

發表於 2013-4-22 15:04 | 只看該作者

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

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

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

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

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

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

TOP

mark15jill

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

7^#

發表於 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

複製代碼

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

kaohsiung-man

小學生 Rank: 1

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: xp
軟體版本: 1
閱讀權限: 10
性別: 男
註冊時間: 2013-4-20
最後登錄: 2013-4-23

6^#

發表於 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

TOP

kaohsiung-man