Excel 禁止雙擊儲存格邊界

Eigen
個人積分：18931分
文章編號：64009198

18931分

樓主

2017-04-14 13:45

Excel 禁止雙擊儲存格邊界

附加壓縮檔: 201704/mobile01-1066a5fe0539d49a8726fcbb9a903117.zip

我有一個 EXCLE 畫面太過密集，經常不小心雙擊到儲存格的邊界就移到畫面最下面，十分困擾

我上網尋找，最後找到的方式就是將 TOOL->OPTION->EDIT->Allow cell drag and drop(使用儲存格拖放功能）取消
Excel 禁止雙擊儲存格邊界

之後我找到更進一步的設定方式，讓特定區域的邊界雙擊移動失效

Dim SaveDragAndDrop As Variant 'For persistence, is declared at module level

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'NOTE: This event fires first, then the Worksheet_BeforeDoubleClick event.
'
'WARNING: Setting a breakpoint in this event will, in effect, cancel any BeforeDoubleClick event, so you can't
' single-step through the whole sequence!

'To prevent unwanted jumping to the "End" of a data-set if the user accidentally double-clicks onto the cell
'border (which is an effect of CellDragAndDrop), disable that functionality while in the range where that
'behavior is a problem.

If Not Intersect(Target, Range("MyProtectedRange")) Is Nothing Then

If IsEmpty(SaveDragAndDrop) Then
SaveDragAndDrop = Application.CellDragAndDrop
Application.CellDragAndDrop = False
End If
Else

If Not IsEmpty(SaveDragAndDrop) Then
Application.CellDragAndDrop = SaveDragAndDrop
SaveDragAndDrop = Empty
End If
End If
End Sub

名稱 MyProtectedRange =Sheet1!$C$4:$F$16

Book_ok.xls 點選黃色部份，雙擊到儲存格的邊界失效

點選空白儲存格，雙擊邊界移動的功能有效

但是這個程式有BUG ，當我點黃色後(失效)，再移到 SHEET2 就通通失效了，必需移回SHEET1，再點選白色儲存可才會再生效。

所以我將 SelectionChange 移到 ThisWorkBook 變成 SheetSelectionChange

但是 Intersect 卻有問題，請問那有問題？應該怎麼修改才能正確

附加壓縮檔: 201704/mobile01-1066a5fe0539d49a8726fcbb9a903117.zip

2017-04-14 13:45 發佈

文章關鍵字 excel 邊界

yuehmao

yuehmao
個人積分：37分
文章編號：64013283

37分

2樓

2017-04-14 19:08

您編寫的Excel檔,在下看過也測試過了,
覺得頗有受益,因為在下之前也沒試過 Application.CellDragAndDrop 這個功能的用途,
現在大致明瞭了,原來是拖拉復製功能的開與關,
您所提的問題,我摸索了一下,發現只要在 ThisWorkBook 這區段的程式碼中加入下面這段內容就大致可以做到了,
但這麼做是強制切換 Sheet 時會自動將 Application.CellDragAndDrop 設為 true 的狀態,
而不是回到原先的狀態(意思就是原先是 True 就回復成 True,原先是 False 就回復成 False),
若要弄得再細膩一點,可能就要考慮用新增一個公用模組,然後將所有 Sheet 的控制都寫在這個模組中,
接著再 Sheet 的區段的程式碼中用 Call 這個指令來呼叫公用模組中的 Sub 執行控制程序來做變數傳遞並控制 Sheet 的變化影響.

snare

snare
個人積分：3057分
文章編號：64013838

3057分

3樓

2017-04-14 20:19

範例：
Sheet1有效，範圍 b3:d10，如果“上邊界”也要禁止，範圍要多加一格

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If ActiveSheet.Name = "Sheet1" Then
If Intersect(Target, Range("b3:d10")) Is Nothing Then
Application.CellDragAndDrop = True
' "範圍外"
Else
Application.CellDragAndDrop = False
' "範圍內"
End If
Else
Application.CellDragAndDrop = True
End If

end sub

Eigen

Eigen
個人積分：18931分
文章編號：64013896

18931分

樓主

2017-04-14 20:26

自問自答：
在 ThisWorkBook 加入
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim ProtectedRange As Range
Set ProtectedRange = Worksheets("Sheet1").Range("c4:f16")

If Sh.Name = "Sheet1" Then

If Application.Intersect(Target, ProtectedRange) Is Nothing Then
Application.CellDragAndDrop = True
Else
Application.CellDragAndDrop = False
End If
Else

Application.CellDragAndDrop = True
End If

End Sub

唯一讓我不解的是
Application.Intersect(Target, ProtectedRange) ok

為什麼
Application.Intersect(Target, MyProtectedRange)
MyProtectedRange =名稱 = =Sheet1!$C$4F$16 為什麼就不行？

snare

snare
個人積分：3057分
文章編號：64014001

3057分

5樓

2017-04-14 20:36

Eigen wrote:
MyProtectedRange =名稱 = =Sheet1!$C$4F$16 為什麼就不行？...(恕刪)

Sheet1!$C$4F$16 ，這是函數(儲存格)的用法，不能用在vba

補充：不好意思，因為沒先下載附件來看，以為程式碼打錯，
沒注意到，myprotectedrange 是定義名稱，本來就沒用在vba

Eigen wrote:
If Sh.Name = "Sheet1" Then...(恕刪)

這行錯了
如果想用 sh.name ，需在上方多加一行
Set sh = ActiveSheet

Eigen wrote:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CellDragAndDrop = True
End Sub...(恕刪)

beforeclose 可以不要
因為下次開啟檔案就會自動啟用，預設值是true，不需特別指定

yuehmao

yuehmao
個人積分：37分
文章編號：64014311

37分

6樓

2017-04-14 21:11

然後在 Book_FIX.xls 這個文件中,..

由於不同 Sheet 間的儲存格似乎不能用來做 Union 或 Intersect 的參照聯集或交集運算,會造成執行錯誤.
因為 MyProtectedRange 的名稱設定是 =Sheet1!$C$4:$F$16 ,屬 Sheet1 的範圍,
而當你切換至 Sheet2 時就會出現將 Sheet2 的儲存格和 Sheet1 的儲存格作 Intersect 的交集運算,
要避免這樣的情況出現.

而 Book_ok.xls 這個文件是只有在 Sheet1 的區段中有判斷程序,
所以不會和 Sheet2 交互干擾到.

snare

snare
個人積分：3057分
文章編號：64015950

3057分

7樓

2017-04-15 0:04

yuehmao wrote:
而當你切換至 Sheet2 時就會出現將 Sheet2 的儲存格和 Sheet1 的儲存格作 Intersect 的比較,
要避免這樣的情況出現.
...(恕刪)

www.ozgrid.com 網站上的這個範例(1樓)，只適合用在一個工作表
而且SaveDragAndDrop那幾行程式碼，其實不必要，可省略。

如果在範圍中有加上工作表名稱sheet1，只要點到其它工作表，Intersect就會出現錯誤訊息
不加工作表名稱，雖然不會有錯誤訊息，但會變成程式在所有工作表都有作用
要指定工作表，需加上if 特別處理
不過 if (sh.name <>"sheet1") then exit sub ，用exit sub不太適合
如果是點在範圍內的儲存格，然後立刻點別的工作表
那CellDragAndDrop 還會在 False 的狀態，會造成其行工作表拖拉功能失效

突然發現用 on error ，程式比較短，可以少用一個if
所以改良一下，再減少4行程式碼，功能同上一個範例(3樓)
一樣可以自由切換工作表，不會出現錯誤訊息

範例：sheet1 a5:b10 範圍有效
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Worksheets("sheet1").Range("a5:b10")) Is Nothing Then
'範圍外，或切換到不同工作表
Application.CellDragAndDrop = True
Else
'範圍內
Application.CellDragAndDrop = False
End If
End Sub

yuehmao

yuehmao
個人積分：37分
文章編號：64018031

37分

8樓

2017-04-15 9:49

snare wrote:
...
不過 if (sh.name <>"sheet1") then exit sub ，用exit sub不太適合
如果是點在範圍內的儲存格，然後立刻點別的工作表
那CellDragAndDrop 還會在 False 的狀態，會造成其行工作表拖拉功能失效...(恕刪)

謝謝 Snare大大的指點^^
經您這麼一提醒,在下也發覺是有這樣的情況沒考慮到...
後來,在下是做了如下的修正.

====================================================
另外,在下也有參考您所採取的方式如下,

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("MyProtectedRange")) Is Nothing Then
'範圍外，或切換到不同工作表
Application.CellDragAndDrop = True
Else
'範圍內
Application.CellDragAndDrop = False
End If
End Sub

發覺這方式的編碼雖然簡潔,但是也存在一個Bug點,
就是當作業步驟如下時,
1. 先在 Sheet1 的設定限制參照範圍內(即黃色區域處)圈選一個參照範圍,
2. 接著直接點選至 Sheet2 ,然後再圈選一個參照範圍,
3. 接著再直接點選回 Sheet1
此時您會發現原本在 Sheet1 中的圈選參照範圍內的 Application.CellDragAndDrop 也是 True 的狀態,
結果,在下發覺發生這問題的主要的原因是-->
當在不同的 Sheet 中切換時, Workbook_SheetSelectionChange 這個 Event 不會立即觸發作用,
因此就會使得要不要將 Application.CellDragAndDrop 開或關的動作選擇失準...

不過,其實感覺您的方式還是比較好,主要是編碼非常簡潔就能達到功能,
而且這個bug並不是很大的問題,只要在 Sheet1 中再重新圈選一次,即可以回復正常.

Eigen

Eigen
個人積分：18931分
文章編號：64021269

18931分

樓主

2017-04-15 16:06

謝謝大家的協助，經過整合大家的意見，我已經完成

附加壓縮檔: 201704/mobile01-327cadc0d8c67eb5cd0f3b6169cca6ca.zip

我在 ThisWorkBook 加上三組巨集，預設 Application.CellDragAndDrop 是enable ，所以在切換檔案、及關閉時，都讓他回到enable ，這樣可以避免下開啟其它檔案、或切換到其它檔案 Application.CellDragAndDrop 失效的情況發生。

主要的 Workbook_SheetSelectionChange 我用if activesheet 的方式來寫，

因為需要特別處理的區域，我是用名稱定義的方式來處理，裏面已經有包含 sheet

避免用 On Error Resume Next + 直接定義 range ，這會造成誤觸其它 sheet 的 range 的問題。

如果有多個sheet ，多個 range 要處理，用 if 會比較容易閱讀

附加壓縮檔: 201704/mobile01-327cadc0d8c67eb5cd0f3b6169cca6ca.zip

'避免影響到整體設定，以免開啟其它檔案時，拖放功能取消
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　　　Application.CellDragAndDrop = True
End Sub

'同上，避免影響到整體設定，以免切換到其它檔案時，拖放功能取消
Private Sub Workbook_Deactivate()
　　　　Application.CellDragAndDrop = True
End Sub

'取消 MyProtectedRange 的雙擊邊界功能
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
　　　　Dim SaveDragAndDrop As Variant '取消特定cells 的雙擊邊界功能，TOOL->OPTION->EDIT->Allow cell drag and drop(使用儲存格拖放功能）取消

　　　　If ActiveSheet.Name = "Sheet1" Then
　　　　　　　　If Intersect(Target, Range("MyProtectedRange")) Is Nothing Then
　　　　　　　　　　　　Application.CellDragAndDrop = True　　　' "範圍外"
　　　　　　　　　　　　
　　　　　　　　Else
　　　　　　　　　　　　Application.CellDragAndDrop = False　　 ' "範圍內"
　　　　　　　　End If
　　　　Else
　　　　　　　　Application.CellDragAndDrop = True
　　　　End If
End Sub

yuehmao

yuehmao
個人積分：37分
文章編號：64023667

37分

10樓

2017-04-15 21:13

Eigen wrote:
...
我在 ThisWorkBook 加上三組巨集，預設 Application.CellDragAndDrop 是enable ，所以在切換檔案、及關閉時，都讓他回到enable ，這樣可以避免下開啟其它檔案、或切換到其它檔案 Application.CellDragAndDrop 失效的情況發生。
...(恕刪)

您加上這樣考慮看來是更加週全了,且編碼也很簡潔,
但似乎看起來,上面那段 Dim SaveDragAndDrop As Variant 好像沒有存在的必要了,除非是另有考量..
其實在您所提的這個使用範例心得,加上 Snare大大的寫法心得,也是另在下多有所悟^^
感覺編碼的樂趣就是從無到有,藝術的建構,大概就是這麼一回事吧.

Excel 禁止 雙擊儲存格邊界

Excel 禁止雙擊儲存格邊界