link:://:.asap-utilities.com/download-asap-utilities-free.php?file=1 (link:://:.asap-utilities.com/download-asap-utilities-free.php?file=1)
link:://:.mrexcel.com/forum/showthread.php?t=158031 (link:://:.mrexcel.com/forum/showthread.php?t=158031)
In the workbook module:
Private Sub Workbook_Deactivate()
Application.CommandBars("Cell").ReSet
End Sub
Private Sub Workbook_Activate()
Run "ModifyRightClick"
End Sub
In a standard module:
Private Sub ModifyRightClick()
Dim O1 As Object, O2 As Object
On Error Resume Next
With CommandBars("Cell")
.Controls("Deselect ActiveCell").Delete
.Controls("Deselect ActiveArea").Delete
End With
On Error GoTo 0
Set O1 = CommandBars("Cell").Controls.Add
With O1
.Caption = "Deselect ActiveCell"
.OnAction = "DeselectActiveCell"
End With
Set O2 = CommandBars("Cell").Controls.Add
With O2
.Caption = "Deselect ActiveArea"
.OnAction = "DeselectActiveArea"
End With
End Sub
Private Sub DeselectActiveCell()
Dim x As Range, why As Range
If Selection.Cells.Count > 1 Then
For Each why In Selection.Cells
If y.Address <> ActiveCell.Address Then
If x Is Nothing Then
Set x = y
Else
Set x = Application.Union(x, y)
End If
End If
Next y
If x.Cells.Count > 0 Then
x.Select
End If
End If
End Sub
Private Sub DeselectActiveArea()
Dim x As Range, why As Range
If Selection.Areas.Count > 1 Then
For Each why In Selection.Areas
If Application.Intersect(ActiveCell, y) Is Nothing
Then
If x Is Nothing Then
Set x = y
Else
Set x = Application.Union(x, y)
End If
End If
Next y
x.Select
End If
End Sub