自定义word右键菜单

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("Tables")

我必须选择整个表格或一列然后它才能工作，但不能在单元格内。单元格内的上下文菜单或表格单元格内的文本的名称是什么？

Answer 1

我做了这个例程来查看 Word 中所有 CommandBars 的名称：

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