Sub ActivMakro()
Dim str As String
str = "'" & ActiveWorkbook.Name & "'!Макрос1"
ActiveWorkbook.Application.Run str
End Sub

Private Sub Workbook_Activate()
   Application.OnKey "^q", "Макрос1"  ' Ctrl+Q - вызов макроса "Макрос1" из данной книги
End Sub

Private Sub Workbook_Activate()
   Application.OnKey "^q", "Макрос2"  ' Ctrl+Q - вызов макроса "Макрос2" из данной книги
End Sub

Private Sub Workbook_Activate()
   On Error Resume Next
   Application.OnKey "^q", "'" & ActiveWorkbook.Name & "'!Макрос1"  ' Ctrl+Q - вызов макроса "Макрос1" из активной книги
End Sub

Private Sub Workbook_Activate()
   On Error Resume Next
   Application.OnKey "^q", "'" & ActiveWorkbook.Name & "'!Макрос2"  ' Ctrl+Q - вызов макроса "Макрос2" из активной книги
End Sub

Private Sub Workbook_Deactivate()
On Error Resume Next
Application.OnKey "^q", ""  ' Ctrl+Q - сброс
End Sub

Private Sub Worksheet_Deactivate()
    On Error Resume Next
    Application.OnKey "^f", "StandardFind"
End Sub

Sub standardFind()
    Application.CommandBars.FindControl(ID:=1849).Execute
End Sub

Sub Get_Control_ID_New()   ' создать новую книгу и вывести на лист список номеров стандартных команд
   Dim sTxt$
   Dim Arr: Arr = Split("msoControlCustom msoControlButton msoControlEdit msoControlDropdown msoControlComboBox msoControlButtonDropdown msoControlSplitDropdown msoControlOCXDropdown msoControlGenericDropdown msoControlGraphicDropdown msoControlPopup msoControlGraphicPopup msoControlButtonPopup msoControlSplitButtonPopup msoControlSplitButtonMRUPopup msoControlLabel msoControlExpandingGrid msoControlSplitExpandingGrid msoControlGrid msoControlGauge msoControlGraphicCombo msoControlPane msoControlActiveX msoControlSpinner msoControlLabelEx msoControlWorkPane msoControlAutoCompleteCombo")   ' подготовка массива-переводчика номера Type в текст msoType
   Dim oCmBr As CommandBar, oCntrl As CommandBarControl, li As Long, xItem
   Application.ScreenUpdating = False
   Dim oDict: Set oDict = CreateObject("Scripting.Dictionary"): oDict.CompareMode = vbTextCompare   ' Создаем словарь
   oDict.Item("header") = Array("Caption", "ID", "Type", "msoType")   ' Заголовок таблицы (попытка чтения значения по отсутствующему ключу добавит ключ в словарь)
   For Each oCmBr In Application.CommandBars
      For Each oCntrl In oCmBr.Controls
         oDict.Item(oCntrl.ID) = Array(oCntrl.Caption, oCntrl.ID, oCntrl.Type, Arr(oCntrl.Type))   ' заносим в словарь массивы значений под ключами oCntrl.ID
      Next oCntrl
   Next oCmBr
   Arr = oDict.Items   ' передать значения в массив. Arr сейчас массив массивов. Его нельзя просто вывести на лист
   Arr = Application.Transpose(Application.Transpose(Arr))   ' двойное транспонирование превращает массив массивов в 2D-массив
   Application.Workbooks.Add   '  создаём новую книгу
   ActiveWorkbook.Sheets(1).Activate
   ActiveSheet.Cells(1, 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr   '  массив - на лист
   ActiveSheet.Name = "Excel Control ID"   '  оформление
   Set oCmBr = Nothing: Set oCntrl = Nothing
   Application.ScreenUpdating = True
End Sub