Personalisation du ruban

alexmesle

XLDnaute Nouveau
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

XLDnaute Impliqué
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.


VB:
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
 

MichD

XLDnaute Impliqué
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

VB:
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
 

Roland_M

XLDnaute Barbatruc
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
 

Discussions similaires

Réponses
4
Affichages
796

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib