我上網尋找,最後找到的方式就是將 TOOL->OPTION->EDIT->Allow cell drag and drop(使用儲存格拖放功能) 取消
[attach]27018[/attach]
之後我找到更進一步的設定方式,讓特定區域的 邊界雙擊移動失效
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
但是 Intersect 卻有問題,請問那有問題?應該怎麼修改才能正確作者: eigen 時間: 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