Настроить слово правой кнопки мыши меню

Question

У меня есть следующий код, чтобы настроить меню правой кнопки мыши:

Sub CreateMenuItem() 
     Dim MenuButton As CommandBarButton 
     With CommandBars("Text") 'Text, Lists and Tables 
      Set MenuButton = .Controls.Add(msoControlButton) 
      With MenuButton 
       .Caption = "Correct" 
       .Style = msoButtonCaption 
       .OnAction = "InsertCorrect" 
      End With 
     End With 
    End Sub 

Он прекрасно работает с текстом и списками, но лишь частично с таблицами:

С CommandBars ("Таблицы ")

Я должен выбрать всю таблицу или столбец, затем она работает, но не внутри ячейки. Каково имя контекстного меню внутри ячейки или для текста внутри ячейки таблицы?

Answer 1

Я сделал эту процедуру, чтобы увидеть Al имена CommandBars в Word:

Sub ListYourCommandBars() 
    For Each c In CommandBars 
     Debug.Print c.Name 
    Next 
End Sub 

Хорошие новости они уже отсортированы в алфавитном порядке. Я нашел один под названием Table Cells. Я пробовал:

With CommandBars("Table Cells") 

И он работал. Единственное, ячейка или несколько ячеек должны быть «полностью выбраны». То есть элемент меню не отображается, если вы просто вводите внутри ячейки, вы должны выбрать ячейку «в целом» (не знаю, как это сказать). Надеюсь это поможет.

Answer 2

Я получил его для работы внутри ячейки таблицы, добавив MenuButton к следующим встроенным командам: «Текст», «Связанный текст», «Текст таблицы», «Параграф шрифта», «Связанные заголовки», «Связанные таблицы», «Связанный текст», «Списки», «Табличные ячейки», «Списки таблиц», «Таблицы», «Таблицы и границы» и «Текстовое поле». Я не уверен, кто на самом деле сделал трюк. Вот мой код:

Private DisableEvents As Boolean 

Private Sub UpdateRightClickMenus() 

    Dim MenuButton As CommandBarButton 
    Dim CommandBarTypes(100) As String 
    Dim i As Long 
    Dim PRChecklistIsSelected As Boolean 
    Dim CheckListTypeFound As Boolean 
    PRChecklist = True 

    ResetRightClickMenus 

    CommandBarTypes(0) = "Text" 
    CommandBarTypes(1) = "Linked Text" 
    CommandBarTypes(2) = "Table Text" 
    CommandBarTypes(3) = "Font Paragraph" 
    CommandBarTypes(4) = "Linked Headings" 
    CommandBarTypes(5) = "Linked Table" 
    CommandBarTypes(6) = "Linked Text" 
    CommandBarTypes(7) = "Lists" 
    CommandBarTypes(8) = "Table Cells" 
    CommandBarTypes(9) = "Table Lists" 
    CommandBarTypes(10) = "Tables" 
    CommandBarTypes(11) = "Tables and Borders" 
    CommandBarTypes(12) = "Text Box" 

    Dim cc As ContentControl 
    Set cc = FindContentControlByTag("ListBox_PR_TR") 

    If IsNull(cc) Then 
     DisableEvents = False 
     Exit Sub 
    End If 

    'Find Selected 
    For i = 1 To cc.DropdownListEntries.Count 
     If cc.Range.Text = "Product Review" Then 
      PRChecklistIsSelected = True 
      CheckListTypeFound = True 
      Exit For 
     End If 
     If cc.Range.Text = "Technical Review" Then 
      PRChecklistIsSelected = False 
      CheckListTypeFound = True 
      Exit For 
     End If 
    Next i 

    If CheckListTypeFound = False Then Exit Sub 

    For i = 0 To 12 

     With Application 

      If PRChecklistIsSelected Then 

       'Add right-click menu option to set as a Product Review comment 
       With .CommandBars(CommandBarTypes(i)) 
        Set MenuButton = .Controls.Add(msoControlButton) 
        With MenuButton 
         .Caption = "Set as Product Review Comment" 
         .Style = msoButtonCaption 
         .OnAction = "Set_as_Product_Review_Comment" 
        End With 
       End With 

      Else 

       'Add right-click menu option to set as a Tech Review comment 
       With .CommandBars(CommandBarTypes(i)) 
        Set MenuButton = .Controls.Add(msoControlButton) 
        With MenuButton 
         .Caption = "Set as Tech Review Comment" 
         .Style = msoButtonCaption 
         .OnAction = "Set_as_Tech_Review_Comment" 
        End With 
       End With 

      End If 

     End With 

    Next i 

    RightClickMenuItemsAdded = True 

End Sub 


Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean) 

    If DisableEvents = True Then Exit Sub 

    Set cc = FindContentControlByTag("ListBox_PR_TR") 

    If IsNull(cc) Then 
     ResetRightClickMenus 
     DisableEvents = False 
     Exit Sub 
    End If 

    If cc.Range.Text = "Technical Review" Then 
     Find_PR_Style_ReplaceWith_TR_Style 
    End If 

    UpdateRightClickMenus 

    DisableEvents = False 

End Sub 

Private Sub Find_PR_Style_ReplaceWith_TR_Style() 

    Set StylePR = ThisDocument.Styles("Product Review Style") 
    Set StyleTR = ThisDocument.Styles("Technical Review Style") 

    With ThisDocument.Content.Find 
     .ClearFormatting 
     .Style = StylePR 
     With .Replacement 
      .ClearFormatting 
      .Style = StyleTR 
     End With 

     .Execute Forward:=True, Replace:=wdReplaceAll, FindText:="", ReplaceWith:="" 
    End With 

End Sub 

Private Sub Set_as_Tech_Review_Comment() 
    Set StyleTR = ThisDocument.Styles("Technical Review Style") 

    With ThisDocument 

     Selection.Style = StyleTR 

     SetCanContinuePreviousList 

    End With 

End Sub 

Private Sub Set_as_Product_Review_Comment() 
    Set StylePR = ThisDocument.Styles("Product Review Style") 

    With ThisDocument 

     Selection.Style = StylePR 

     SetCanContinuePreviousList 

    End With 

End Sub 

Private Sub SetCanContinuePreviousList() 

    Dim lfTemp As ListFormat 
    Dim intContinue As Integer 
    Dim oldListNumber As Single 

    Set lfTemp = Selection.Range.ListFormat 
    oldListNumber = lfTemp.ListValue 
    If Not (lfTemp.ListTemplate Is Nothing) Then 
     intContinue = lfTemp.CanContinuePreviousList(_ 
     ListTemplate:=lfTemp.ListTemplate) 
     lfTemp.ApplyListTemplate _ 
     ListTemplate:=lfTemp.ListTemplate, _ 
     ContinuePreviousList:=False, _ 
     ApplyTo:=wdListApplyToWholeList 
     If lfTemp.ListValue = oldListNumber Then 
      lfTemp.ApplyListTemplate _ 
      ListTemplate:=lfTemp.ListTemplate, _ 
      ContinuePreviousList:=True, _ 
      ApplyTo:=wdListApplyToWholeList 
     End If 
    End If 

Set lfTemp = Nothing 

End Sub 

Private Function FindContentControlByTag(Tag As String) As ContentControl 

    For Each cc In ThisDocument.ContentControls 

     If cc.Tag = Tag Then 

      Set FindContentControlByTag = cc 
      Exit Function 

     End If 

    Next 

End Function 

Private Sub ResetRightClickMenus() 

    Dim CommandBarTypes(100) As String 
    Dim i As Long 

    CommandBarTypes(0) = "Text" 
    CommandBarTypes(1) = "Linked Text" 
    CommandBarTypes(2) = "Table Text" 
    CommandBarTypes(3) = "Font Paragraph" 
    CommandBarTypes(4) = "Linked Headings" 
    CommandBarTypes(5) = "Linked Table" 
    CommandBarTypes(6) = "Linked Text" 
    CommandBarTypes(7) = "Lists" 
    CommandBarTypes(8) = "Table Cells" 
    CommandBarTypes(9) = "Table Lists" 
    CommandBarTypes(10) = "Tables" 
    CommandBarTypes(11) = "Tables and Borders" 
    CommandBarTypes(12) = "Text Box" 

    For i = 0 To 12 

     Application.CommandBars(CommandBarTypes(i)).Reset 

    Next i 

    RightClickMenuItemsAdded = False 
End Sub 

Private Sub Document_Open() 

    UpdateRightClickMenus 

End Sub 

Private Sub Document_Close() 

    ResetRightClickMenus 

End Sub