eigen

帖子: 79
主題: 33
精華: 0
積分: 123
點名: 0
作業系統: win7
軟體版本: x64
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2013-10-24
最後登錄: 2024-3-28

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2017-4-14 13:26 | 顯示全部帖子

[發問] 禁止雙擊儲存格邊界

禁止雙擊儲存格邊界

border double click.zip (17.39 KB)

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

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

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

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 卻有問題，請問那有問題？應該怎麼修改才能正確

樓主熱帖

公開經驗，創造智慧（我又不靠這過活）

eigen

中學生 Rank: 2

帖子: 79
主題: 33
精華: 0
積分: 123
點名: 0
作業系統: win7
軟體版本: x64
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2013-10-24
最後登錄: 2024-3-28

2^#

發表於 2017-4-14 15:30 | 顯示全部帖子

自問自答：
在 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$4

F$16 為什麼就不行？

公開經驗，創造智慧（我又不靠這過活）

TOP

eigen

中學生 Rank: 2

帖子: 79
主題: 33
精華: 0
積分: 123
點名: 0
作業系統: win7
軟體版本: x64
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2013-10-24
最後登錄: 2024-3-28

3^#

發表於 2017-4-15 16:10 | 顯示全部帖子

回復 2# eigen

有興趣的，可以到 https://www.mobile01.com/topicdetail.php?f=511&t=5120593&p=1#64021269

看到相關的討論，我也有整理完的範例~~

公開經驗，創造智慧（我又不靠這過活）

TOP

eigen

中學生 Rank: 2

帖子: 79
主題: 33
精華: 0
積分: 123
點名: 0
作業系統: win7
軟體版本: x64
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2013-10-24
最後登錄: 2024-3-28

4^#

發表於 2017-5-4 14:58 | 顯示全部帖子

回復 3# eigen

有沒有高手能指點一下，我用 Application.CellDragAndDrop = False ' "範圍內"

已經能 enable /disable 雙擊邊界的功能

但是Application.CellDragAndDrop 這個功能，會讓儲存格無法被 select / copy /paste ，實在是太麻煩了，能不能請高手指點一下？

如何將目前select/copy 的資料備份下來？以便當 Application.CellDragAndDrop 切換時，再還原位置回來

公開經驗，創造智慧（我又不靠這過活）

TOP