Ворд как погасить появление контекстного меню по нажатию ПКМ

Private Sub App_WindowBeforeRightClick(ByVal Sel As Selection, Cancel As Boolean)
 
    Beep
   
End Sub

Cancel = True
Beep
End Sub

Private Sub app_WindowSelectionChange(ByVal Sel As Selection)
    'MsgBox Sel, vbInformation
    Application.CommandBars(100).ShowPopup
End Sub

Private Sub app_WindowSelectionChange(ByVal Sel As Selection)
'MsgBox Sel, vbInformation
Application.CommandBars(100).ShowPopup
End Sub

 Прячем все что есть в этом меню
For Each cnt In Application.CommandBars(100).Controls
    cnt.Visible = False
    Next cnt
  
добавляем свои элементы меню  
    For i = 0 To 5
    Set MyPoint = Application.CommandBars(100).Controls.Add
    MyPoint.Caption = "item" + CStr(i)
    Next i
    
показываем
    Application.CommandBars(100).ShowPopup

Прячем все что есть в этом меню
For Each cnt In Application.CommandBars(100).Controls
    cnt.Visible = False
    Next cnt
  
добавляем свои элементы меню  
    For i = 0 To 5
    Set MyPoint = Application.CommandBars(100).Controls.Add
    MyPoint.Caption = "item" + CStr(i)
    Next i
    
показываем
    Application.CommandBars(100).ShowPopup

Private Sub app_WindowSelectionChange(ByVal Sel As Selection)
    'MsgBox Sel, vbInformation
    ln = Len(Sel)
    If ln > 1 Then
    
    For Each cnt In Application.CommandBars(100).Controls
    cnt.Visible = False
    Next cnt
    
    For i = 0 To 5
    Set MyPoint = Application.CommandBars(100).Controls.Add
    MyPoint.Caption = "item" + CStr(i)
    MyPoint.OnAction = "MySub"
    MyPoint.Parameter = MyPoint.Caption
    Next i
    Application.CommandBars(100).ShowPopup
    End If
End Sub
 
Private Sub MySub()
    MsgBox CommandBars.ActionControl.Parameter, vbInformation
End Sub

 Sleep 500
    For Each cnt In Application.CommandBars(100).Controls
        cnt.Visible = False
    Next cnt

Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
Application.CommandBars("Text").Controls(msoControlButton).ShowPopup
    'или
Application.CommandBars("Text").Controls.ShowPopup

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10
 
Public Sub SingleClick()
  SetCursorPos 100, 100 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
 
Public Sub DoubleClick()
  'Double click as a quick series of two clicks
  SetCursorPos 100, 100 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
 
Public Sub RightClick(x As Integer, y As Integer)
  'Right click
  SetCursorPos x, y 'x and y position
  mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub
 
Public Sub RightClick()
  'Right click
  mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Private WithEvents app As Application
Dim mClass As New Class1
 
Private Sub Document_Open()
Set app = Application
End Sub
 
Private Sub app_WindowSelectionChange(ByVal Sel As Selection)
    ln = Len(Sel)
    If ln > 1 Then
    'Application.CommandBars("Standard").ShowPopup
    'SendKeys ("+{F10}")
    mClass.RightClick
    End If
End Sub