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

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2013-4-20 11:34 | 只看該作者

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

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

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

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

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

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

22^#

發表於 2013-5-20 08:31 | 只看該作者

回復 21# ML089

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

test.zip (10.78 KB)

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

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

21^#

發表於 2013-5-19 18:49 | 只看該作者

回復 19# GBKEE

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

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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

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

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