Info

Enter the following procedures in a standard module:

Sub ModifyRightClick()

Dim 01 As Object, 02 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

Sub DeselectActiveCell()

Dim x As Range, y As Range

If Selection.Cells.Count > 1 Then

For Each y In Selection.Cells

If y.Address <> ActiveCell.Address Then

If x Is Nothing Then

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

Sub DeselectActiveArea() Dim x As Range, y As Range If Selection.Areas.Count > 1 Then For Each y 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

Dim x As Range, y As Range

Add the following procedures to the ThisWorkbook module:

0 0

Post a comment