Personalisation du ruban

[alexmesle]

Bonjour a tous,
Nouveau sur ce forum, désolé si cette question à été posée !!!
Je cale sur un problème de personnalisation du ruban.

j'ais mis 6 bouton pour aller sur des feuilles précises. Le "bouton id" à le même nom que la feuille de destination
pas d'erreur à la validation mais dans excel cela ne fonctionne pas.

est-il obligatoire de créer une macro dans le classeur ?

quel syntaxe mettre ?

Merci pour votre aide

Le début du code est ci-après :
Le nom du classeur est :Gestion 2012-2013.xlsm

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon>
<tabs>
<tab id="OSMOSE" label="OSMOSE">
<group id="GESTION" label="GESTION OSMOSE">
<button id="VENTE" label="Vente et Caisse" size="large" imageMso="FunctionsFinancialInsertGallery" onAction="'Vente" />
<button id="REL_BANK" label="Relevés Banque" size="large" imageMso="AttachMenu" onAction="REL_BANK" />
<button id="HA_STOCK" label="Achats et Stock" size="large" imageMso="LabelInsert" onAction="HA_STOCK" />
<button id="DRH" label="DRH / Social" size="large" imageMso="MeetingsWorkspace" onAction="DRH" />
<button id="ANALYSE" label="Tableau de Bord" size="large" imageMso="WatchWindow" onAction="ANALYSE" />
<button id="GRAPH" label="Graphique OSMOSE" size="large" imageMso="ChartInsert" onAction="GRAPH" />
</group[/SIZE]

 

[MichD]

Re : Personalisation du ruban

Bonjour,

Tu as parfaitement raison. Merci pour la correction.

Quant à faire, je me permets d'ajouter le menu "Graphique" (ID:=30022) à la barre des menus.

Sub Creer_Menu_Excel_2003()
 On Error Resume Next
 'Supprime la barre "MichD" si elle existe
 Application.CommandBars("MichD").Delete
 
'Créer une barre de menu personnalisée
 Set MichD = Application.CommandBars.Add("MichD", , True)
 
'copie les menus dans la nouvelle barre des menus
 With Application.CommandBars("Built-in Menus")
      .FindControl(ID:=30002).Copy MichD
      .FindControl(ID:=30003).Copy MichD
      .FindControl(ID:=30004).Copy MichD
      .FindControl(ID:=30005).Copy MichD
      .FindControl(ID:=30006).Copy MichD
      .FindControl(ID:=30007).Copy MichD
      .FindControl(ID:=30022).Copy MichD
      .FindControl(ID:=30011).Copy MichD
      .FindControl(ID:=30009).Copy MichD
      .FindControl(ID:=30010).Copy MichD
    End With
 'Rendre visible la nouvelle barre des menus
 'Elle sera disponible sous l'onglet "Complément" de
 'la barre des menus dans les versions Excel 2007 et 2010
 Application.CommandBars("MichD").Visible = True
End Sub

 

[Roland_M]

Re : Personalisation du ruban

re

mais ou trouves-tu les ID correspondant !
tu fais des essais ?

 

[Misange]

Re : Personalisation du ruban

Hello
ici
List of ID numbers for built-in CommandBar controls in Excel 2000

 

[Roland_M]

Re : Personalisation du ruban

re

merci Misange c'est sympa !

 

[MichD]

Re : Personalisation du ruban

Procédure écrite par Stephen Bullen, auteur de plusieurs livres sur Excel et VBA.
Amazon.com: Stephen Bullen: Books, Biography, Blog, Audiobooks, Kindle

Sub ListFirstLevelControls()
   Dim cbCtl As CommandBarControl
   Dim cbBar As CommandBar
   Dim i As Integer
   If Not IsEmptyWorksheet(ActiveSheet) Then Exit Sub
   On Error Resume Next
   Application.ScreenUpdating = False
   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
   i = 2
   For Each cbBar In CommandBars
      Application.StatusBar = "Processing Bar " & cbBar.Name
      Cells(i, 1).Value = cbBar.Name
      i = i + 1
      For Each cbCtl In cbBar.Controls
         Cells(i, 2).Value = cbCtl.Caption
         cbCtl.CopyFace
         If Err.Number = 0 Then
            ActiveSheet.Paste Cells(i, 3)
            Cells(i, 3).Value = cbCtl.FaceId
         End If
         Cells(i, 4).Value = cbCtl.ID
         Err.Clear
         i = i + 1
      Next cbCtl
   Next cbBar
   Range("A:B").EntireColumn.AutoFit
   Application.StatusBar = False
End Sub
'------------------------------------------------------------
Function IsEmptyWorksheet(Sht As Object) As Boolean
   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

 

[alexmesle]

Re : Personalisation du ruban

Merci, super !

Enfin la soluce....

 

[Roland_M]

Re : Personalisation du ruban

re à tous

petite astuce supplémentaire pour cette formidable macro,
créer une feuille nommée selon version exemple 2003 puis une autre 2007 etc...
et tester au début de la routine la version pour selectionner la bonne feuille:

Select Case Int(Val(Application.Version))
Case Is < 7: F$ = "<1995"
Case 7: F$ = "1995"
Case 8: F$ = "1997"
Case 9: F$ = "2000"
Case 10: F$ = "2001"
Case 11: F$ = "2003"
Case 12: F$ = "2007"
Case 13, 14: F$ = "2010"
Case Is > 14: F$ = ">2010"
End Select
Sheets(F$).Activate

 

[alexmesle]

Re : Personalisation du ruban

Merci pour ce coup de pouce.
Je bloquais dessus.....