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

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

帖子: 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

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

kaohsiung-man

小學生 Rank: 1

帖子: 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

kaohsiung-man

小學生 Rank: 1

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

14^#

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

回復 12# GBKEE

超版大~~

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

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

敬請指教 ... 謝謝!

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兔年全勤獎章

15^#

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

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

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

TOP

kaohsiung-man

小學生 Rank: 1

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

16^#

發表於 2013-4-22 18:57 | 只看該作者

回復 15# GBKEE

超版大~~

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

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

敬請指教 ... 謝謝!

TOP

kaohsiung-man

小學生 Rank: 1

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

17^#

發表於 2013-4-23 08:49 | 只看該作者

回復 12# GBKEE

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

謝謝!{:3_59:}

TOP

kaohsiung-man

小學生 Rank: 1

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

18^#

發表於 2013-4-23 08:50 | 只看該作者

回復 9# mark15jill

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

謝謝!

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兔年全勤獎章

19^#

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

複製代碼

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

TOP

die78325

　暱稱: 新鮮貨幽杉

中學生 Rank: 2

帖子: 94
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: win 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 桃園
註冊時間: 2012-10-17
最後登錄: 2014-1-3

20^#

發表於 2013-5-9 16:47 | 只看該作者

回復 18# kaohsiung-man

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

自用車也可以簽帳喔!
五千元加油金加入油箱後還回饋您6200元
福利旺車友會power-want.com

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]