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（＆＃34; Tables＆＃34;）

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

Answer 1

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

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

好消息他们已按字母顺序排序。我发现了一个叫Table Cells的人。我试过了：

With CommandBars("Table Cells")

它有效。只有东西，细胞或许多细胞必须被完全选择＆＃34;。也就是说，如果您只是进入单元格内部，则菜单项不会显示，您必须选择单元格＆＃34;作为一个整体＆＃34; （不知如何更好地说）。希望这会有所帮助。

Answer 2

我通过将MenuButton添加到以下内置CommandBars中来使其在表格单元格中工作：“文本”，“链接文本”，“表格文本”，“字体段落”，“链接标题”，“链接表“，”链接文本“，”列表“，”表格单元格“，”表格列表“，”表格“，”表格和边框“和”文本框“。我不确定哪一个真正做到了。这是我的代码：

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

自定义单击右键菜单

2 个答案: