Listado ID de comandos en Excel 2003.

Leyendo la pregunta de un lector realizada a través de un comentario empecé a recordar donde tenía una macro donde se listaban todos los códigos de los comandos de Excel 2003, hace ya algún tiempo desarrollé un código donde se inahilitaban algunos comandos de los menús y barras de herramientas (ver).

...hay algun código que me permita inhabilitar Guardar como en el menú Archivo para las hojas de gráficos (no una hoja de cálculo con gráfico sino las hojas que son gráficas). Queda inhabilitado el botón de la barra de herramientas pero no el comando Guardar como del menú Archivo. Gracias. PD: tampoco me inhabilita el menú Herramientas....

Para resolver la cuestión del lector y otras más reproduczo el código vba que obtuve hace mucho tiempo en algún foro de Excel que no puedo recordar, y aunque se trate de una mala práctica el no nombrar al autor, creo que se entenderá por la utilidad general de éste:

Este primer código introduce las cabeceras y revisa todos los comandos, añadiendo si se dispone una imagen del icono del comando.

Sub ListFirstLevelControls()
Dim ctl As CommandBarControl
Dim cbr As CommandBar
Dim iRow As Integer
If Not IsEmptyWorksheet(ActiveSheet) Then Exit Sub
'Ignore errors and freeze screen
On Error Resume Next
Application.ScreenUpdating = False
'Enter headings
Cells(1, 1).Value = "CommandBar"
Cells(1, 2).Value = "Control"
Cells(1, 3).Value = "FaceID"
Cells(1, 4).Value = "ID"
Cells(1, 1).Resize(1, 4).Font.Bold = True
'Start at row 2
iRow = 2
'Loop through all commandbars
For Each cbr In CommandBars
Application.StatusBar = "Processing Bar" & cbr.Name
Cells(iRow, 1).Value = cbr.Name
iRow = iRow + 1
'Loop through controls on commandbar
For Each ctl In cbr.Controls
Cells(iRow, 2).Value = ctl.Caption
'Try to get image
ctl.CopyFace
If Err.Number = 0 Then
ActiveSheet.Paste Cells(iRow, 3)
Cells(iRow, 3).Value = ctl.FaceId
End If
Cells(iRow, 4).Value = ctl.ID
Err.Clear
iRow = iRow + 1
Next ctl
Next cbr
Range("A:D").EntireColumn.AutoFit
Application.StatusBar = False
End Sub

Esta función comprueba que la hoja donde se desplegarán los ID de los comandos está vacia.

Function IsEmptyWorksheet(sht As Object) As Boolean
'If sht is a worksheet, count the non empty cells
If TypeName(sht) = "Worksheet" Then
If WorksheetFunction.CountA(sht.UsedRange) = 0 Then
IsEmptyWorksheet = True
Exit Function
End If
End If
MsgBox "Please make sure that an empty worksheet is active"
End Function

Esta rutina repasa las barras de comando y ejecuta la función anterior.

Sub ListAllControls()
Dim cbr As CommandBar
Dim rng As Range
Dim ctl As CommandBarControl
'Test for empty worksheet and freeze screen
If Not IsEmptyWorksheet(ActiveSheet) Then Exit Sub
Application.ScreenUpdating = False
'Start in A1 cell
Set rng = Range("A1")
'Loop through all commandbars
For Each cbr In Application.CommandBars
Application.StatusBar = "Processing Bar" & cbr.Name
'‘List name of bar
rng.Value = cbr.Name
'Loop through controls on bar
For Each ctl In cbr.Controls
'Call ListControls function
Set rng = rng.Offset(ListControls(ctl, rng))
Next ctl
Next cbr
'Fit columns to data
Range("A:J").EntireColumn.AutoFit
Application.StatusBar = False
End Sub

Esta función, empleando los códigos anteriores lista el nombre del control y el tipo que es.

Function ListControls(ctl As CommandBarControl, rng As Range) As Long
Dim lOffset As Long 'Tracks current row relative to rng
Dim ctlSub As CommandBarControl 'Control contained in ctl
'Ignore Errors
On Error Resume Next
'Start in rng cell
lOffset = 0
'List control name and type
rng.Offset(lOffset, 1).Value = ctl.Caption
rng.Offset(lOffset, 2).Value = ctl.Type
'Attempt to copy control face. If error, don’t paste
ctl.CopyFace
If Err.Number = 0 Then
ActiveSheet.Paste rng.Offset(lOffset, 3)
rng.Offset(lOffset, 3).Value = ctl.FaceId
End If
Err.Clear
'Check Control Type
Select Case ctl.Type
Case 1, 2, 4, 6, 7, 13, 18
'Do nothing for these control types
Case Else
'Call function recursively if current control contains other controls
For Each ctlSub In ctl.Controls
lOffset = lOffset + _
ListControls(ctlSub, rng.Offset(lOffset, 2))
Next ctlSub
lOffset = lOffset - 1
End Select
ListControls = lOffset + 1
End Function

Como se puede ver son varias funciones y macros con las que conseguimos el listado de ID de todos los comandos de Excel 2003.