Programmierter Rechtsklick funzt nicht

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cmdBtn As CommandBarButton
On Error Resume Next
With Application
.CommandBars("Cell").Controls("Dokument einfügen").Delete
Set cmdBtn = .CommandBars("Cell").Controls.Add(Temporary:=True)
End With
With cmdBtn
.Caption = "Dokument einfügen"
.Style = msoButtonCaption
.OnAction = "InsertDoc"
End With
On Error GoTo 0
End Sub