小松鼠及拾荒老人的家

Excel:turn off cell border double click disable 關閉儲存格邊界雙擊後快速移動到最後一個空格的方法

在 Excel 儲存格的邊界上，雙擊就會移動到該方向的最後一個空格位置

這對一些畫面很複雜的EXCEL 而言，實在是很困擾，難搞到不行

這個問題從有 Excel 就一直存在，我逛了很久的英文網頁，只找到三個解法

一、將 TOOL->OPTION->EDIT->Allow cell drag and drop(使用儲存格拖放功能） 取消

二、演生出來的另一個做法就是 某些檔案才取消

利用巨集，在特定檔案中加入巨集程式，當檔案開啟、關閉時，會自動切換上述動作

在 ThisWorkSBook 中加入

Private Sub Worksheet_Activate()
'Deactivates the Double-Click Border Jump when sheet is opened.
    Application.CellDragAndDrop = False 
End Sub

Private Sub Workbook_BeforeClose()
    Application.CellDragAndDrop = True 'Activates the Double-Click Border Jump when sheet is opened.
End Sub

三、將失效的部份限制在特定檔案的特定儲存格，這就是我要的

a、將要失效的特定儲存格，命名成 MyProtectedRange

b、利用巨集，在 ThisWorkSBook 中加入以上程式即可

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 

最後整理結果，在 ThisWorkBook 中加入以下三個 巨集，透過設定 MyProtectedRange 名稱的方式 控制儲存格邊界雙擊功能

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

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

'取消特定cells 的雙擊邊界功能，TOOL->OPTION->EDIT->Allow cell drag and drop(使用儲存格拖放功能） 取消
'取消 MyProtectedRange 的雙擊邊界功能，MyProtectedRange用名稱方式定義=計算機!$O$16:$O$264,計算機!$A$18:$I$267，不能跨 sheets 會無法分辦
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
        On Error Resume Next
        If ActiveSheet.Name = Range("MyProtectedRange").Parent.Name Then        '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