Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Rbar As CommandBar
Const Cb = "RightClick"
Cancel = True
On Error Resume Next: CommandBars(Cb).Delete: On Error GoTo 0
Set Rbar = CommandBars.Add(Cb, msoBarPopup, , True)
With Rbar
With .Controls.Add(msoControlButton, , , .Controls.Count + 1, True)
.Caption = "Copier en colorant"
.FaceId = 19
.OnAction = Me.CodeName & ".CopyWithCol"
End With
With .Controls.Add(msoControlPopup, , , .Controls.Count + 1, True)
.Caption = "Autres Choix"
FromBar = IIf(Target.ListObject Is Nothing, "Cell", "List Range Popup")
For Each CBar In Application.CommandBars(FromBar).Controls
.Controls.Add CBar.Type, CBar.ID, , , True
Next
End With
.ShowPopup
.Delete
End With
End Sub
Sub CopyWithCol()
Application.CutCopyMode = False
Selection.Copy
Selection.Interior.Color = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
End Sub