Sub ListShortCutMenus()
Cells.Clear
Application.ScreenUpdating = False
Row = 1
For Each cbar In CommandBars
If cbar.Type = msoBarTypePopup Then
Cells(Row, 1) = cbar.Index
Cells(Row, 2) = cbar.Name
For col = 1 To cbar.Controls.Count
Cells(Row, col + 2) = _
cbar.Controls(col).Caption
Next col
Row = Row + 1
End If
Next cbar
Cells.EntireColumn.AutoFit
End Sub