Excel 从上下文菜单更改父按钮名称

我已经创建了一个自定义右键单击上下文菜单

我想在单击任何子菜单项时更新父按钮标题

Option Explicit

Public Const Mname As String = "MyPopUpMenu"

Sub PopUpMenu()

    ' Create the custom right click menu.
    Call RClickMenu

    ' Display the popup menu.
    On Error Resume Next
    Application.CommandBars(Mname).ShowPopup
    On Error GoTo 0
End Sub

自定义右键单击菜单：

Sub RClickMenu()

Dim MenuItem As CommandBarPopup
Dim SectionType As String
 = "Sections"

' Add the popup menu.
With Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, _
     MenuBar:=False, Temporary:=True)

    Set MenuItem = .Controls.Add(Type:=msoControlPopup)
    With MenuItem
        .caption = "File Type"

        With .Controls.Add(Type:=msoControlButton)
            .caption = "File 1"
            .OnAction = "setCaption"
            .Parameter = "file1"
        End With

        With .Controls.Add(Type:=msoControlButton)
            .caption = "File 2"
            .OnAction = "setCaption"
            .Parameter = "file2"
        End With

    End With

End With
End Sub

右键单击时的鼠标下键事件：

Public Sub btnFindSections_MouseDown(ByVal button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If button = 1 Then
        ActiveWorkbook.FollowHyperlink "https://www.file.com"
    ElseIf button = 2 Then
        PopUpMenu
    End If
End Sub

设置标题方法：

Sub setCaption()
    Select Case CommandBars.ActionControl.Parameter
    Case "Sections"
        ActiveSheet.Shapes("CommandButton1").Name = "Sections" // Error saying item not found
    End Select
End Sub

在

setCaption（）

中，我需要找到父按钮，并将其标题从

find files

更改为

find Sections

尝试替换（如果是ActiveX按钮）：

与

如果是“表单”按钮，则将同一行替换为：

ActiveSheet.Buttons("CommandButton1").Caption = "Lists"

在上面的示例中，代码按照您的要求使用按钮

Name

如果需要使用ActiveX按钮的

标题

，则必须使用下一个迭代代码：

Sub TestButtonCaptionSearch()
  Dim but As OLEObject
    For Each but In ActiveSheet.OLEObjects
        If but.Object.Caption = "CommandButton1" Then
            but.Object.Caption = "Lists": Exit For
        End If
    Next
End Sub

---

错误：无法获取

窗体的工作表类的按钮属性

错误：错误：无法获取

活动X的工作表类的OleObjects属性

@kittu:您的按钮是什么类型的？它是放在纸上还是放在表格上？如果在工作表上，看起来很可能，它是activeX类型还是表单类型？它是activeX类型button@kittu：如果你标记我（@FaneDuru），我可以试着帮你。。。但是你没有让代码成为公认的答案……我试着玩你的“弹出菜单”，我问自己为什么在

Application.CommandBars（Mname）.ShowPopup

行之前使用

On Error Resume Next

。通常，只有当特定的

CommandBar

可以创建两次时，才会发生错误。在这种情况下，在创建之前删除它是很好的，但我很好奇在你的情况下是什么原因…@FaneDuru这行是从我发现的示例中复制的，我想。我需要检查其意义尝试，请使用

ShowRightClickMenu

sub中的

DeleteToolbar

，就在带有Application.CommandBars的

行前面。添加（…

。该sub看起来像：

Private sub DeleteToolbar（）

错误恢复下一步
应用程序.CommandBars（Mname）.Delete
On Error GoTo 0
End Sub
。注意，有5行代码。在这里，
On Error Resume Next
对于不存在此类栏的情况很重要…@FaneDuru知道如何在右键单击菜单中将控制按钮字体设置为粗体吗？是的，我想是的，但我现在没有时间。。。
ActiveSheet.Buttons("CommandButton1").Caption = "Lists"

Sub TestButtonCaptionSearch()
  Dim but As OLEObject
    For Each but In ActiveSheet.OLEObjects
        If but.Object.Caption = "CommandButton1" Then
            but.Object.Caption = "Lists": Exit For
        End If
    Next
End Sub