La personnalisation du ruban sous Excel 2007

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="OngletPerso" label="Exemples de labelControl">
                <group id="GR1" label="Test">
                    <labelControl id="LC01" label=" Mon texte 01" />
			  
			  <separator id="Sep01"/>
                    
			  <labelControl id="LC02" label="Montexte 02" />
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="OngletPerso" label="Exemples ComboBox">
                <group id="GR1" label="Test">
			<comboBox id="CB1" label="Coefficient" onChange="ChangeCB1" > 
      			<item id="it1" label="1" imageMso="MacroPlay" /> 
      			<item id="it2" label="1,25" imageMso="CellsInsertDialog" /> 
      			<item id="it3" label="1,5" imageMso="FileOpen" /> 
      			<item id="it4" label="1,8" imageMso="Spelling" />
			</comboBox>
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

'Callback for CB1 onChange
Sub ChangeCB1(control As IRibbonControl, text As String)
    MsgBox text
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" >
<ribbon startFromScratch="false">
<tabs>

<tab id="OngletPerso" label="OngletPerso" visible="true">
   <group id="Projet01" label="Projet 01">

      <!-- getItemCount="NbItemCombo" va définir le nombre d'items dans la combobox. --> 
      <!-- getItemLabel="ComboLabel" permet d'alimenter la combobox. -->
      <!-- invalidateContentOnDrop="true" permet la mise à jour automatique du contrôle. -->

      <comboBox id="Combo1" label="Choix : " getItemCount="NbItemCombo" getItemLabel="ComboLabel"
         invalidateContentOnDrop="true" />
   </group>
</tab>

</tabs>
</ribbon>
</customUI>

'Callback for Combo1 getItemCount
Sub NbItemCombo(control As IRibbonControl, ByRef returnedVal)
    'Définit le nombre d'éléments dans la combobox
    
    'Récupère le nombre de données dans la colonne A.
    returnedVal = Feuil1.Range("A65536").End(xlUp).Row
End Sub


'Callback for Combo1 getItemLabel
'Index est défini par la valeur saisie dans la fonction de rappel NbItemCombo
Sub ComboLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
    
    If Feuil1.Range("A65536").End(xlUp).Row = 0 Then Exit Sub
    
    'Alimente le Combobox à partir des données de la plage de cellules
    returnedVal = Feuil1.Cells(index + 1, 1)
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="objRuban"> 

  <ribbon>
    <tabs>
      <tab id="Planning" label="Gestion planning" >
        <group id="Calendrier" label="Le calendrier">

		<gallery id="gallery01" 
			size="large"
			imageMso="StartAfterPrevious" 
			label="Sélectionnez un mois :" 
			columns="3" 
			rows="4"
			getItemCount="NbMois"
			showItemLabel="true"
			getItemLabel="LabelMois"
			onAction="SelectionMois" > 
		
		   <button id="button01" 
			label="Sélectionnez une date particulière :"
			imageMso="InkingStart" 
			onAction="ChargeDtPicker"/> 
		</gallery> 

        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

Option Explicit

Public MonRuban As IRibbonUI
Dim Usf As Object


'Callback for customUI.onLoad
'Est déclenché lors du chargement du ruban personnalisé.
Sub objRuban(ribbon As IRibbonUI)
    Set MonRuban = ribbon
End Sub


'Callback for gallery01 getItemCount
Sub NbMois(control As IRibbonControl, ByRef returnedVal)
    returnedVal = 12
End Sub


'Callback for gallery01 getItemLabel
Sub LabelMois(control As IRibbonControl, index As Integer, ByRef returnedVal)
    returnedVal = Application.Proper(MonthName(index + 1))
End Sub


'Callback for gallery01 onAction
Sub SelectionMois(control As IRibbonControl, id As String, index As Integer)
    ActiveCell.Value = Application.Proper(MonthName(index + 1))
End Sub


'Callback for button01 onAction
Sub ChargeDtPicker(control As IRibbonControl)
    LancementProcedureCalendrier
End Sub



'Cet exemple utilise le contrôle DataPicker
'Vous devez disposer de l'ocx MSCOMCT2.ocx sur votre poste
Sub LancementProcedureCalendrier()
    Dim X As Object
    Dim NomdtPicker As String
    
    NomdtPicker = "DtPicker1"
    Set X = UserForm_Et_DataPicker_Dynamique(NomdtPicker)
    
    X.Show
    
    ThisWorkbook.VBProject.VBComponents.Remove Usf
    Set Usf = Nothing
End Sub


Function UserForm_Et_DataPicker_Dynamique(NomObjet As String) As Object
    Dim Obj As Object
    Dim j As Integer
    Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    With Usf
        .Properties("Caption") = "Mon calendrier"
        .Properties("Width") = 130
        .Properties("Height") = 40
    End With
  
    Set Obj = Usf.Designer.Controls.Add("MSComCtl2.DTPicker.2")
          
    With Obj
        .Left = 0: .Top = 0: .Width = 130: .Height = 20
        .Name = NomObjet
        .CalendarBackColor = &HFF00FF
    End With
    
    With Usf.CodeModule
        j = .CountOfLines
        .insertlines j + 1, "Sub " & NomObjet & "_Change()"
        .insertlines j + 2, "   ActiveCell.Value = Format(DateSerial(Year(" _
            & NomObjet & "), Month(" & NomObjet & "), Day(" _
            & NomObjet & ")), " & Chr(34) & "dd mmmm yyyy" & Chr(34) & ")"
        'Option pour refermer l'userform après l'insertion de la date.
        '.insertlines j + 3, "   Unload Me"
        .insertlines j + 4, "End Sub"
    End With
    
    VBA.UserForms.Add (Usf.Name)
    Set UserForm_Et_DataPicker_Dynamique = UserForms(UserForms.Count - 1)
  
End Function

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> 
   <ribbon startFromScratch="false">
      <tabs>
        <tab id="TB01" label="Test">
			<group id="GR01" label="Essais de boutons">

				<!-- réutilise un bouton standard --> 
				<button idMso="CalculateNow" size="normal" visible="true" />

				<!-- réutilise un bouton standard en modifiant l'intitulé --> 
				<button idMso="Spelling" label="Intitulé personnalisé" size="normal"/>

				<!-- crée un bouton personnel et réutilise l'image de la commande 'Orthographe' --> 
				<button id="BtPerso02" imageMso="Spelling" onAction="MaProcedure"
					  label="Lancez la procédure" size="normal"/>

			    <separator id="Sep01"/>

				<!-- crée un bouton personnel --> 
				<button id="BtPerso01" onAction="MaProcedure"
					  label="Lancez la procédure" keytip="DVP" 
					  supertip="Ce bouton possède&#13;un raccourci clavier : DVP"
					  size="normal"/>
					  
			</group>
        </tab>
      </tabs>
   </ribbon>
</customUI>

'Callback for MaProcedure onAction
Sub MaProcedure(control As IRibbonControl)
    MsgBox "Vous avez cliqué sur le bouton " & control.ID
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">

    <tabs>
        <tab id="TB01" label="Test">

		<group id="GR01" label="test box" >
			<box id="Box01" boxStyle="vertical">
				<control idMso="ChartStylesGallery"/>
				<control idMso="ChartLayoutGallery"/>
				<control idMso="ChartSwitchRowColumn"/>
			</box>

			<separator id="Sep01"/>		

			<control idMso="ChartSaveTemplates" />
		</group>
        </tab>
    </tabs>

</ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
   <ribbon startFromScratch="false">
      <tabs>
         <tab id="tab1" label="Test" >
            <group id="GR01" label="Essai de checkbox">
               <checkBox id="CheckBox1"
                  label="Option"  
                  onAction="Validation" />
            </group>
         </tab>
      </tabs>
   </ribbon>
</customUI>

'Callback for CheckBox1 onAction
Sub Validation(control As IRibbonControl, pressed As Boolean)
    MsgBox control.ID & vbCrLf & pressed
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="OngletPerso" label="Test">
                <group id="GR01" label="Exemple utilisation editBox">

			<box id="Box01" boxStyle="horizontal">                    
				<editBox id="editBox01" 
					label="Saisissez le code :"
					onChange="RecupDonnee"
					screentip="Le code doit contenir 5 caractères maximum." 
					sizeString="99999"
					maxLength="5"/>
			</box>

			<button id="button01" 
				onAction="ValidationCode"
				label="Validez le code"
				imageMso="FileServerTasksMenu"
				size="normal"/>

                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

Option Explicit

Dim Cible As String


'Callback for editBox01 onChange
Sub RecupDonnee(control As IRibbonControl, text As String)
    Cible = text
End Sub


'Callback for button01 onAction
Sub ValidationCode(control As IRibbonControl)
    MsgBox Cible
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
onLoad="objRuban" >

   <ribbon startFromScratch="false">
      <tabs>
        <tab id="Tab01" label="Test">
			<group id="GR01" label="Essais de buttonGroup et toggleButton">

				<buttonGroup id="BG01">

					<toggleButton id="TB01" imageMso="FormatPainter"
						getPressed="ProcPressed"
						onAction="MaProcedure"/>

					<toggleButton id="TB02" imageMso="Copy"
						getPressed="ProcPressed"
						onAction="MaProcedure"/>

					<toggleButton id="TB03" imageMso="Cut"
						getPressed="ProcPressed"
						onAction="MaProcedure"/>

				</buttonGroup>

			</group>
        </tab>
      </tabs>
   </ribbon>
</customUI>

Option Explicit

Public MonRuban As IRibbonUI


'Callback for customUI.onLoad
Sub objRuban(ribbon As IRibbonUI)
    Set MonRuban = ribbon
End Sub


'Callback for toggleButton.getPressed
Sub ProcPressed(control As IRibbonControl, ByRef returnedVal)
    'returnedVal=
End Sub


'Callback for toggleButton.onAction
Sub MaProcedure(control As IRibbonControl, pressed As Boolean)
    MsgBox control.ID & vbCrLf & pressed
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="OngletPerso" label="Exemples dropDown">
                <group id="GR1" label="Test">
			<dropDown id="Drop01" label="Choix" onAction="NomProcedure" > 
      			<item id="it1" label="AA" imageMso="MacroPlay" /> 
      			<item id="it2" label="BB" imageMso="CellsInsertDialog" /> 
				<item id="it3" label="CC" imageMso="FileOpen" /> 
     				<item id="it4" label="DD" imageMso="Spelling" />
			</dropDown>
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

'Callback for Drop01 onAction
Sub NomProcedure(control As IRibbonControl, id As String, index As Integer)
    MsgBox control.id & vbCrLf & id & vbCrLf & index
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">

  <commands>
    <!-- Désactive le bouton "Couleur de remplissage" -->
    <command idMso="CellFillColorPicker" enabled="false" />
  </commands>

<ribbon startFromScratch="false">

</ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">

  <commands>
    <!-- Réattribue l'action du bouton "Insérer un lien hypertexte" -->
    <command idMso="HyperlinkInsert" onAction="MacroDeRemplacement" />
  </commands>

<ribbon startFromScratch="false">

</ribbon>
</customUI>

'Callback for HyperlinkInsert onAction
Sub MacroDeRemplacement(control As IRibbonControl, ByRef cancelDefault)
    MsgBox "Procédure de remplacement du bouton : " & vbCrLf & control.id
    
    'Attribuez la valeur False à l'argument cancelDefault pour réactiver par VBA
    'la fonctionnalité prédéfinie:
    
    'cancelDefault = False
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
   <ribbon startFromScratch="false">
      
	<tabs>
        <tab id="Tab01" label="Test">
			<group id="GR01" label="Essais de menus">

				<menu id="Menu01" label="mon Menu perso" itemSize="normal"> 
   					<toggleButton id="ToggleButton01" label="exemple toggleButton 01" /> 
					<toggleButton id="ToggleButton02" label="exemple toggleButton 02" /> 
   					<button id="bt01" label="Button01" /> 
				
						<menu id="SousMenu01" label="Sous Menu 01" itemSize="normal"> 
      						<button id="bt02" label="Button02" /> 
      						<button id="bt03" label="Button03" /> 
      						<button id="bt04" label="Button04" /> 
      						
							<menu id="SousMenu02" label="Sous Menu 02" itemSize="large"> 
      							<button id="bt05" label="Button05" /> 
         							<button id="bt06" label="Button06" />  
     							</menu> 
   						</menu> 
				</menu>  

			</group>
        </tab>
      </tabs>

   </ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">

    <tabs>
        <tab id="Ongletperso" label="Liste feuilles">

            <group id="GR01" label="Test">

            <dynamicMenu id="ListeDynamique"
                label="Liste feuilles"
                getContent="CreationMenuDynamique"
                invalidateContentOnDrop="true"
                size="normal"
                imageMso="PrintTitles"/>
            </group>

        </tab>
    </tabs>

</ribbon>
</customUI>

Option Explicit

'Callback for ListeDynamique getContent
'Procédure pour construire le menu dynamique
Public Sub CreationMenuDynamique(ctl As IRibbonControl, ByRef content)
    'ouverture de la balise menu
    content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">"

    'liste les feuilles de calcul du classeur actif
    content = content & ListeFeuilles(ActiveWorkbook)

    'liste les feuilles graphiques du classeur actif
    content = content & ListeCharts(ActiveWorkbook)

    'fermeture de la balise
    content = content & "</menu>"
End Sub



Private Function ListeFeuilles(Wb As Workbook) As String
    Dim strTemp As String
    Dim Ws As Worksheet
    
    ' Insertion d'un titre de menu
    strTemp = "<menuSeparator id=""Feuilles"" title=""Feuilles""/>"

    ' ajoute un bouton dans le menu pour chaque feuille du classeur
    For Each Ws In Wb.Worksheets
        strTemp = strTemp & _
            "<button " & _
            CreationAttribut("id", "Bt" & Ws.Name) & " " & _
            CreationAttribut("label", Ws.Name) & " " & _
            CreationAttribut("tag", Ws.Name) & " " & _
            CreationAttribut("onAction", "ActivationFeuille") & "/>"
    Next

    ListeFeuilles = strTemp
End Function


'Liste les feuilles graphiques contenues dans le classeur
Private Function ListeCharts(Wb As Workbook) As String
    Dim strTemp As String
    Dim Ch As Chart
    
    If Wb.Charts.Count = 0 Then Exit Function
    
    strTemp = "<menuSeparator id=""charts"" title=""charts""/>"

    For Each Ch In Wb.Charts
        strTemp = strTemp & _
            "<button " & _
            CreationAttribut("id", "Bt" & Ch.Name) & " " & _
            CreationAttribut("label", Ch.Name) & " " & _
            CreationAttribut("tag", Ch.Name) & " " & _
            CreationAttribut("onAction", "ActivationFeuille") & "/>"
    Next

    ListeCharts = strTemp
End Function


Function CreationAttribut(strAttribut As String, Donnee As String) As String
    CreationAttribut = strAttribut & "=" & Chr(34) & Donnee & Chr(34)
End Function



'Active la feuille sélectionnée lorsque vous cliquez sur un nom
'dans le menu.
Sub ActivationFeuille(control As IRibbonControl)
    Sheets(control.Tag).Activate
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
   <ribbon startFromScratch="false">
      
	<tabs>
        <tab id="Tab01" label="Test">
			<group id="GR01" label="Essais de splitButton">

				<splitButton id="Split01" >
				<menu>
					<button id="button01" imageMso="FileLinksToFiles" label="Lier" />
					<button id="button02" imageMso="FileExit" label="Fermer" />
					<button id="button03" imageMso="FileProperties" label="Aide" />

				</menu>
				</splitButton>

			</group>
        </tab>
      </tabs>

   </ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="OngletPerso" label="Exemple de séparateur">
                <group id="GR1" label="Test">
                	<button id="BT01" label="Lancement"
      			onAction="Macro01" 
				size="normal" imageMso="CalculateNow" />
                	<button id="BT02" label="Répéter"
      			onAction="Macro02" 
				size="normal" imageMso="Repeat" />					        

			  <separator id="Sep01"/>

                	<button id="BT03" label="Connection"
      			onAction="Macro03" 
				size="normal" imageMso="HyperlinkInsert" />                    

                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
   <ribbon startFromScratch="false">
      <tabs>
         <tab id="TAB01" label="Test" >
            <group id="GR01" label="Essai dialogBoxLauncher">
               <button id="BT01" 
                  idMso="SortCustomExcel" 
                  label="bouton 01" 
                  size="normal" />
               <dialogBoxLauncher>
                  <button id="BT02" 
                     screentip= "Affichage d'une boîte de dialogue depuis le lanceur dialogBoxLauncher." 
                     onAction="MaProcedure02" />
               </dialogBoxLauncher>
             </group>
          </tab>
      </tabs>
   </ribbon>
</customUI>

Public Sub MaProcedure02(ByVal control As IRibbonControl)
    
    MsgBox "MsgBox affiché depuis le lanceur "
    
    'Pour lancer un UserForm
    'UserForm1.Show
End Sub