Контекстное меню (RightClickMenu) Excel: работает только в одной книге, я хочу, чтобы она работала везде

Question

У меня есть книги с "ContextMenu" code (XML + VBA). Все отлично работает, но не все книги. Есть 2 варианта кода. 1 - начинается с книги Excel; 2 - работает после нажатия на кнопку в «ContextMenu».

Я использовал методы, описанные на этих сайтах (оба сайта имеют одинаковую информацию). Microsoft rondebruin

Я немного модернизировал коды. Ниже публикуйте код для одной книги Excel с «Динамическим меню».

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
   <contextMenus>
      <contextMenu idMso="ContextMenuCell">
         <dynamicMenu 
            id="MyDynamicMenu" 
            label= "My Dynamic Menu" 
            imageMso="HappyFace" 
            getContent="GetContent" 
            insertBeforeMso="Cut"/>
      </contextMenu>
   </contextMenus>
</customUI>

---

Option Explicit

'MyDynamicMenu (component: dynamicMenu, attribute: getContent), 2010+
Sub GetContent(control As IRibbonControl, ByRef returnedVal)
    Dim xml As String

        xml = "<menu xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
              "<button id=""but1"" imageMso=""Help"" label=""About"" onAction=""HelpMacro""/>" & _
              "<button id=""but2"" imageMso=""FindDialog"" label=""Find information"" onAction=""FindMacro""/>" & _
              "<menu id=""MyMacroSubMenu"" label=""Macro Sub-Menu"" itemSize=""large"">" & _
              "<button id=""Sub1But1"" imageMso=""AppointmentColor1"" label=""Macro1"" onAction=""Macro1"" description=""Description Macro1""/>" & _
              "<button id=""Sub1But2"" imageMso=""AppointmentColor2"" label=""Macro3"" onAction=""Macro2"" description=""Description Macro2""/>" & _
              "<button id=""Sub1But3"" imageMso=""AppointmentColor3"" label=""Macro3"" onAction=""Macro3"" description=""Description Macro3""/>" & _
              "</menu>" & _
              "</menu>"

    returnedVal = xml
End Sub

'Callback for macro
Sub FindMacro(control As IRibbonControl)
    MsgBox "Find macro"
End Sub

Sub Macro1(control As IRibbonControl)
    MsgBox "Macro 1 in menu"
End Sub

Sub Macro2(control As IRibbonControl)
    MsgBox "Macro 2 in menu"
End Sub

Sub Macro3(control As IRibbonControl)
    MsgBox "Macro 3 in menu"
End Sub

=============================================

1. Я пытался добавить через - Разработчик> Надстройки
2. Вставка кода в - C: \ Users [MyPC] \ AppData \ Roaming \ Microsoft \ Excel \ XLSTART \ PERSONAL.XLSB
3. Также, когда я ставлю этот код, я получаю сообщение об ошибке:

Private Sub Workbook_Activate()

 Call AddToCellMenu End Sub

Private Sub Workbook_Deactivate()

 Call DeleteFromCellMenu End Sub

НИЧЕГО НЕ ПОМОГАЕТ!?

Answer 1

Вы можете попробовать что-то вроде этого ... когда вы щелкнете правой кнопкой мыши, появится боковое меню для upper case, lower case, proper case.

Sub AddToCellMenu()

    Dim ContextMenu As CommandBar
    Dim MySubMenu As CommandBarControl

    ' Delete the controls first to avoid duplicates.
    Call DeleteFromCellMenu

    ' Set ContextMenu to the Cell context menu.
    Set ContextMenu = Application.CommandBars("Cell")

    ' Add one built-in button(Save = 3) to the Cell context menu.
    ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, before:=1

    ' Add one custom button to the Cell context menu.
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "ToggleCaseMacro"
        .FaceId = 59
        .Caption = "Toggle Case Upper/Lower/Proper"
        .Tag = "My_Cell_Control_Tag"
    End With

    ' Add a custom submenu with three buttons.
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, before:=3)

    With MySubMenu
        .Caption = "Case Menu"
        .Tag = "My_Cell_Control_Tag"

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "UpperMacro"
            .FaceId = 100
            .Caption = "Upper Case"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "LowerMacro"
            .FaceId = 91
            .Caption = "Lower Case"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "ProperMacro"
            .FaceId = 95
            .Caption = "Proper Case"
        End With
    End With

    ' Add a separator to the Cell context menu.
    ContextMenu.Controls(4).BeginGroup = True
End Sub

Sub DeleteFromCellMenu()
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl

    ' Set ContextMenu to the Cell context menu.
    Set ContextMenu = Application.CommandBars("Cell")

    ' Delete the custom controls with the Tag : My_Cell_Control_Tag.
    For Each ctrl In ContextMenu.Controls
        If ctrl.Tag = "My_Cell_Control_Tag" Then
            ctrl.Delete
        End If
    Next ctrl

    ' Delete the custom built-in Save button.
    On Error Resume Next
    ContextMenu.FindControl(ID:=3).Delete
    On Error GoTo 0
End Sub

Sub ToggleCaseMacro()
    Dim selectedRange As Range
    Dim cell As Range

    On Error Resume Next
    Set selectedRange = Intersect(Selection, _
        Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
    On Error GoTo 0
    If selectedRange Is Nothing Then Exit Sub

    Application.ScreenUpdating = False

    For Each cell In selectedRange.Cells
        Select Case cell.value
        Case UCase(cell.value): cell.value = LCase(cell.value)
        Case LCase(cell.value): cell.value = StrConv(cell.value, vbProperCase)
        Case Else: cell.value = UCase(cell.value)
        End Select
    Next cell

    Application.ScreenUpdating = True

End Sub

Sub UpperMacro()
    Dim selectedRange As Range
    Dim cell As Range

    On Error Resume Next
    Set selectedRange = Intersect(Selection, _
        Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
    On Error GoTo 0
    If selectedRange Is Nothing Then Exit Sub

Application.ScreenUpdating = False

    For Each cell In selectedRange.Cells
        cell.value = UCase(cell.value)
    Next cell

Application.ScreenUpdating = True

End Sub

Sub LowerMacro()
    Dim selectedRange As Range
    Dim cell As Range

    On Error Resume Next
    Set selectedRange = Intersect(Selection, _
        Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
    On Error GoTo 0
    If selectedRange Is Nothing Then Exit Sub

Application.ScreenUpdating = False

    For Each cell In selectedRange.Cells
        cell.value = LCase(cell.value)
    Next cell

Application.ScreenUpdating = True

End Sub

Sub ProperMacro()
    Dim selectedRange As Range
    Dim cell As Range

    On Error Resume Next
    Set selectedRange = Intersect(Selection, _
        Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
    On Error GoTo 0
    If selectedRange Is Nothing Then Exit Sub

Application.ScreenUpdating = False

    For Each cell In selectedRange.Cells
        cell.value = StrConv(cell.value, vbProperCase)
    Next cell

Application.ScreenUpdating = True

End Sub

Answer 2

Я понял, почему это не сработало.

---

1. Откройте новую книгу, затем "Сохранить как" "RightClickMenu.xlam"
2. Затем поместите ее сюда C:\Users\USER\AppData\Roaming\Microsoft\AddIns\
3. Выше на предлагаемом сайте 2 варианта " RightClickMenu ".Я решил использовать без dynamicMenu, потому что он работает быстрее.
4. Откройте нашу книгу уже в Ribbon XML Editor ↵ или Custom UI Editor ↵ и вставьте XML-кодтам:

↴

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
   <contextMenus>
      <contextMenu idMso="ContextMenuCell">
         <menu
			 id="SubMenu1"
			 label="RightClickMenu"
			 insertBeforeMso="QuickAnalysis"
			 imageMso="AcceptAndAdvance">
            <button idMso="Calculator"/>
            <button idMso="MultiplicationSign"/>
			<menuSeparator id="sep_1"/>
			<menu
			   id="SubMenu2"
			   image="Hand"
			   label="Спец Примечание"
			   itemSize="large">
			   <button
			   id="MenuButton1"
			   label="Yellow"
               imageMso="ColorYellow"
			   onAction="Special_NoteYellow"/>
			   <button
			   id="MenuButton2"
			   label="Teal"
               imageMso="ColorTeal"
			   onAction="Special_NoteTeal"/>
		    </menu>
         </menu>
        <menuSeparator id="sep_2" insertBeforeMso="Cut"/>
      </contextMenu>
   </contextMenus>
</customUI>

5. Далее введите VBA-код ALT + F11 - это наши кнопки.Вы можете добавить столько кнопок, сколько хотите.DynamicMenu можно расширить, как вам нравится:

↴

Option Explicit

Sub Special_NoteYellow(control As IRibbonControl)
Dim myComm As Comment
  If Not ActiveCell.Comment Is Nothing Then
    If MsgBox("The cell already contains a note, delete?", 4) - 7 Then
      ActiveCell.Comment.Delete
    Else: Exit Sub
    End If
  End If

Set myComm = ActiveCell.AddComment
    With myComm.Shape 'exhibiting the required format
      .Height = 110
      .Width = 200
      .AutoShapeType = 1
      .Fill.ForeColor.SchemeColor = 13
      .Line.ForeColor.RGB = RGB(255, 0, 0)
      .DrawingObject.Font.Name = "Consolas"
      .DrawingObject.Font.FontStyle = "normal"
      .DrawingObject.Font.Size = 10
     End With
      'emulate the choice of "Change note"
       SendKeys "+{F2}"
End Sub

Sub Special_NoteTeal(control As IRibbonControl)
Dim myComm As Comment
  If Not ActiveCell.Comment Is Nothing Then
    If MsgBox("The cell already contains a note, delete?", 4) - 7 Then
      ActiveCell.Comment.Delete
    Else: Exit Sub
    End If
  End If

Set myComm = ActiveCell.AddComment
    With myComm.Shape 'exhibiting the required format
      .Height = 110
      .Width = 200
      .AutoShapeType = 1
      .Fill.ForeColor.SchemeColor = 15
      .Line.ForeColor.RGB = RGB(255, 0, 0)
      .DrawingObject.Font.Name = "Consolas"
      .DrawingObject.Font.FontStyle = "normal"
      .DrawingObject.Font.Size = 10
     End With
      'emulate the choice of "Change note"
       SendKeys "+{F2}"
End Sub

Внимание!Для сохранения изменений необходимо:

• надстройка .xlam «Сохранить как» .xlsm.
• Редактируйте то, что нам нужно (вставьте значки, кнопки, меню и т. Д.).
• Далее «Сохранить как» .xlam!

Теперь поговорим о вставке вашей иконки.Для меню мы можем изменить значок в Ribbon XML Editor ↵ или Custom UI Editor ↵.Используйте эту запись - imageMso="HappyFace" или мы можем вставить собственную иконку image="Hand" для staticMenu.Если мы используем код DynamicMenu, который описан выше, значок, который необходимо вставить в строку VBA image="Hand".

PS - также для собственного меню мы можем использовать атрибуты:

↴

button
checkBox
control
dynamicMenu
gallery
menu
menuSeparator
splitButton
toggleButton

• Если нам понадобится включить RightClickMenu для нас во всех книгах:
• Перейдите на вкладку разработчика> Надстройки Excel.
• Или ... Файл> Параметры> Надстройки> Управление> Надстройки Excel> Перейти ... (проверьте созданную нами надстройку, если вы поместили ее в другую папку - используйте кнопку «Обзор»).

excel vba