Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Control As Object
Dim Rbar As CommandBar
Dim Sbar As String
Const Cb = "ClicDroit"
Select Case True
Case Target.Count > 1
' Case Not Application.Intersect(Target, [b2:d12]) Is Nothing ' pour appliquer à une plage
Case Else
Cancel = True 'empêche l'affichage normal du menu d'Excel
On Error Resume Next: CommandBars(Cb).Delete: ' On Error GoTo 0
Set Rbar = CommandBars.Add(Cb, msoBarPopup, , True)
With Rbar
With .Controls.Add(msoControlButton, , , , True)
.Caption = "Reprendre le Questionnaire"
.OnAction = "'" & Me.CodeName & ".Reprendre'"
'.FaceId = 327
End With
With .Controls.Add(msoControlButton, , , , True)
.Caption = "Débuter le Questionnaire"
.OnAction = "'" & Me.CodeName & ".Reinit'"
'.FaceId = 327
End With
With .Controls.Add(msoControlPopup, , , , True)
.Caption = "Plus ..."
Sbar = IIf(Target.ListObject Is Nothing, "Cell", "List Range Popup")
For Each Control In CommandBars(Sbar).Controls
Control.Copy .CommandBar
Next
End With
Application.ScreenUpdating = True
.ShowPopup
.Delete
End With
End Select
End Sub
Sub Reprendre()
MsgBox "Reprendre"
End Sub