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