Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Cbar As CommandBarControl
Dim Rbar As CommandBar
Const Cb = "RightClick"
If Target.Count = 1 Then
If Evaluate("=Cell(""format""," & Target.Address & ")") Like "C*" _
Or Evaluate("=Cell(""format""," & Target.Address & ")") Like ",*" _
Or Evaluate("=Cell(""format""," & Target.Address & ")") Like "F*" Then
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, 1, , 1, True)
.Caption = "Euro"
.FaceId = 1408: .OnAction = Me.CodeName & ".Set_Symbol"
End With
With .Controls.Add(msoControlButton, 1, , 2, True)
.Caption = "Dollar"
.FaceId = 1408: .OnAction = Me.CodeName & ".Set_Symbol"
End With
With .Controls.Add(msoControlButton, 1, , 3, True)
.Caption = "Rand"
.FaceId = 1408: .OnAction = Me.CodeName & ".Set_Symbol"
End With
.Controls.Add(msoControlButton, 1, , 4, True).BeginGroup = True
' On recopie les controles standards du double_clic sur Cellule
For Each Cbar In CommandBars("Cell").Controls
Cbar.Copy Rbar
Next
' Affichage du menu contextuel
.ShowPopup
.Delete
End With
End If
End If
End Sub
Sub Set_Symbol2()
Select Case Application.CommandBars.ActionControl.Caption
Case "Euro": Selection.NumberFormat = "# ##0.00 [$EUR]"
Case "Dollar": Selection.NumberFormat = "# ##0.00 [$USD]"
Case "Rand": Selection.NumberFormat = "# ##0.00 [$ZAR]"
End Select
End Sub
Sub Set_Symbol()
Select Case Application.CommandBars.ActionControl.Caption
Case "Euro": Selection.NumberFormat = "# ##0.00 €"
Case "Dollar": Selection.NumberFormat = "# ##0.00 $"
Case "Rand": Selection.NumberFormat = "[$R-436]# ##0.00"
End Select
End Sub