Numéro ID des menus et sous-menus

Bonjour à tous !

Comment connaitre les numéro ID des menus (fichier, affichage..) et sous-menus (imprimer, zoom...) d'excel (version 2003) ??

Merci beaucoup de votre aide,

Amicalement

Bonsoir,

Un début de réponse

Cdlt

Option Explicit
Sub ListeBarre()
     Dim cbar As CommandBar

     Cells(1, 1).Select

     For Each cbar In Application.CommandBars 'pour chaque barre de l'application
          ActiveCell = cbar.Index                      'index de la barre dans la cellule active
          ActiveCell.Offset(0, 1) = cbar.NameLocal 'nom local de la barre dans la cellule située à droite de la cellule active
          ActiveCell.Offset(0, 2) = cbar.Name ' nom de la barre dans la cellule située à 2 colonnes à droite de la cellule active
          ActiveCell.Offset(1, 0).Select 'sélection de la cellule situé sous la cellule active
     Next
End Sub

Re,

Plus complet, cette procédure doit correspondre à ta demande

Cdlt

Attribute VB_Name = "CommandesBarreMenus"

'toutes les commandes de la barre de menus d'Excel dans une feuille de calcul !
'(y compris celles qui correspondent à des fonctionnalités non disponibles...)

Sub RecordMenuBar()
'RB Smissaert, mpep
    'puts all the menubar button properties in a table
    Application.ScreenUpdating = False

    Dim RW As Boolean
    Dim CBC As CommandBarControl
    Dim C As Variant
    Dim C2 As Variant
    Dim i As Byte
    Dim M As Byte
    Dim n As Integer

    Range(Cells(1), Cells(1).SpecialCells(xlLastCell)).Clear

    n = 1

    Dim Msg, Style, Title, response
    Msg = "RECORD  WHOLE  MENUBAR ?"
    Style = vbYesNo + vbDefaultButton2 + vbQuestion
    Title = "   RECORD  MENUBAR"

    response = MsgBox(Msg, Style, Title)

    If response = vbYes Then
        RW = True
    End If

    On Error Resume Next
    With Range(Cells(1), Cells(9))
        .Font.Bold = True
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    End With

    Cells(1) = "Level"
    Cells(2).Value = "Caption"
    Cells(3).Value = "Index"
    Cells(4).Value = "Type"
    Cells(5).Value = "ID"
    Cells(6).Value = "OnAction"
    Cells(7).Value = "ShortcutText"
    Cells(8).Value = "Width"
    Cells(9).Value = "Style"

    For Each CBC In CommandBars.ActiveMenuBar.Controls

        If RW = True Then
            n = n + 1

            i = CBC.Index
            Range(Cells(n, 1), Cells(n, 9)).Interior.ColorIndex = 6
            Cells(n, 1).Value = "P"
            Cells(n, 2).Value = CBC.Caption
            Cells(n, 3).Value = i
            Cells(n, 4).Value = CBC.Type
            Cells(n, 5).Value = CBC.ID
            Cells(n, 6).Value = CBC.OnAction
            Cells(n, 7).Value = CBC.ShortcutText
            Cells(n, 8).Value = CBC.Width
            If CBC.Type = 1 Then
                Cells(n, 9).Value = CBC.Style
            Else
                Cells(n, 9).Value = ""
            End If
        Else

            If CBC.BuiltIn = False Then
                n = n + 1
                i = CBC.Index
                Range(Cells(n, 1), Cells(n, 9)).Interior.ColorIndex = 6
                Cells(n, 1).Value = "P"
                Cells(n, 2).Value = CBC.Caption
                Cells(n, 3).Value = i
                Cells(n, 4).Value = CBC.Type
                Cells(n, 5).Value = CBC.ID
                Cells(n, 6).Value = CBC.OnAction
                Cells(n, 7).Value = CBC.ShortcutText
                Cells(n, 8).Value = CBC.Width
                If CBC.Type = 1 Then
                    Cells(n, 9).Value = CBC.Style
                Else
                    Cells(n, 9).Value = ""
                End If
            End If
        End If

        If CBC.Index = i And CBC.Type = 10 Or CBC.Type = 12 Then
            For Each C In CommandBars.ActiveMenuBar.Controls(i).Controls
                n = n + 1
                M = C.Index
                Range(Cells(n, 2), Cells(n, 9)).Interior.ColorIndex = 37
                Cells(n, 1).Value = "S"
                Cells(n, 2).Value = C.Caption
                Cells(n, 3).Value = M
                Cells(n, 4).Value = C.Type
                Cells(n, 5).Value = C.ID
                Cells(n, 6).Value = C.OnAction
                Cells(n, 7).Value = C.ShortcutText
                Cells(n, 8).Value = C.Width
                Cells(n, 9).Value = C.Style

                If C.Index = M And C.Type = 10 Or C.Type = 12 Then
                    For Each C2 In _
                      CommandBars.ActiveMenuBar.Controls(i).Controls(M).Controls
                        n = n + 1
                        Range(Cells(n, 3), Cells(n, 9)).Interior.ColorIndex = 34
                        Cells(n, 1).Value = "T"
                        Cells(n, 2).Value = C2.Caption
                        Cells(n, 3).Value = C2.Index
                        Cells(n, 4).Value = C2.Type
                        Cells(n, 5).Value = C2.ID
                        Cells(n, 6).Value = C2.OnAction
                        Cells(n, 7).Value = C2.ShortcutText
                        Cells(n, 8).Value = C2.Width
                        Cells(n, 9).Value = C2.Style
                    Next
                End If
            Next
        End If
    Next

    Application.ScreenUpdating = True

End Sub

Bonjour Jean-Éric,

C'est IMPECCABLE !! Respects

Par contre puis-je abuser de ta patience et de demander s'il te serait possible d'appliquer ton code à un classeur Excel 2003 ?? J'ai besoin 2007 à la maison mais 2003 au boulot... Sinon pas grave !

Merci beaucoup de ton aide,

Amicalement

EDIT: tu me diras, les codes sont peut être les mêmes entre ces 2 versions...

Re,

Cela doit fonctionner sous 2000, 2003, etc...

A tester, je suis sous 2010.

Il y a bien une personne du forum qui pourra contrôler

Cdlt.

Re-,

Je souhaite désactiver certaines commandes (d'où ma question )

J'ai écrit le code suivant (je sais que ça vous fait mal aux yeux... )

Private Sub Workbook_Open()

Application.CommandBars("Worksheet Menu Bar").FindControl(ID:=30002).Enabled = True
  With Application
  .CommandBars.FindControl(ID:=18).Enabled = False
  .CommandBars.FindControl(ID:=23).Enabled = False
  .CommandBars.FindControl(ID:=106).Enabled = False
  .CommandBars.FindControl(ID:=3).Enabled = False
  .CommandBars.FindControl(ID:=748).Enabled = False
  .CommandBars.FindControl(ID:=3823).Enabled = False
  .CommandBars.FindControl(ID:=846).Enabled = False
  .CommandBars.FindControl(ID:=5905).Enabled = False
  .CommandBars.FindControl(ID:=7994).Enabled = False
  .CommandBars.FindControl(ID:=31308).Enabled = False
  .CommandBars.FindControl(ID:=7990).Enabled = False
  .CommandBars.FindControl(ID:=7991).Enabled = False
  .CommandBars.FindControl(ID:=7993).Enabled = False
  .CommandBars.FindControl(ID:=30205).Enabled = False
  .CommandBars.FindControl(ID:=4).Enabled = False
  .CommandBars.FindControl(ID:=30095).Enabled = False
  .CommandBars.FindControl(ID:=750).Enabled = False

End With
End Sub

Je ne vois aucun changement sur mon fichier (excel 2007), quelqu'un aurait-il la gentillesse de le tester sur 2003 ??

Merci !

Amicalement

Re,

Ci-joint fichier issu de la procédure sous 2010 (identique entre 2007 & 2010 ; apparition du ruban)

Cdlt