Personnalisation du ruban Powerpoint 2007
Hors ligneRoza76 Le 02/12/2014 à 12:23 Profil de Roza76 Configuration de Roza76

Bonjour,

Je veux personnaliser un ruban PowerPoint 2007 avec un fichier xml (utilisation de Custum UI Editor) et des macros VBA (fichier pptm). Le problème que je rencontre est que le nouveau ruban ne se charge pas du tout.Pourriez-vous m'aider ? D'avance merci.

Voici mon code xml

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

<tabs>
<!-- onglet perso-->
<tab id="Help" label="Nouvel onglet">
<!-- groupe personnalisé-->
<group id="helpcolor" label="Couleurs et polices">
<!--galery remplissage-->
<gallery id="palette" size="normal" imageMso="FontFillBackColorPicker" label="Couleur remplissage" columns="4" rows="2" getItemCount="NbCouleur" showItemLabel="false" getItemLabel="LabelCouleur" getItemImage="iconeCouleur" itemWidth="12" itemHeight="12" onAction="fontColor">
</gallery>
<gallery id="palette2" size="normal" imageMso="FontShadingColorMoreColorsDialog" label="Couleur police" columns="4" rows="2" getItemCount="NbCouleur" showItemLabel="false" getItemLabel="LabelCouleur" getItemImage="iconeCouleur" itemWidth="12" itemHeight="12" onAction="policeColor">
</gallery>
<button id="bt01" label="Arial 10" size="normal" onAction="arial" imageMso="FontColorPicker" />
<button id="bt02" label="Century gothic 10" size="normal" onAction="century" imageMso="FontColorPicker" />
</group>
</tab>
</tabs>

</ribbon>
</customUI>

Code VBA

Option Explicit

Public HelpeviaRuban As IRibbonUI
Dim Usf As Object
'Callback for customUI.onLoad
'chargement du ruban
Sub objRuban(ribbon As IRibbonUI)
Set HelpeviaRuban = ribbon
End Sub

'Callback getItemCount
'nbre items
Sub NbCouleur(control As IRibbonControl, ByRef returnedVal)
returnedVal = 8
End Sub

'Callback getItemLabel
Sub LabelCouleur(control As IRibbonControl, index As Integer, ByRef returnedVal)
Dim Labelnom As Variant
Labelnom = Array("jaune", "rose", "vert", "orange", "bleu", "vert pin", "noir 70", "noir 20")
'On Error Resume Next
returnedVal = Labelnom(index)
'On Error GoTo 0
End Sub

'Callback getItemImage
'récupération des images d'items
Sub iconeCouleur(control As IRibbonControl, index As Integer, ByRef image)
Set image = stdole.LoadPicture("C:\Users\GERALDINEL\Documents\office_2007\ruban_personnalise\dossier_fichier\images\img" & index + 1 & ".gif")
End Sub
'Callback onAction
Sub fontColor(control As IRibbonControl, id As String, index As Integer)
'Call the macro that belongs to the label when you click one of the labels.
'Example: When you click the first label it runs the macro named "macro_1".
'On Error Resume Next
Application.Run "macro_" & Format(index + 1, "00")
'On Error GoTo 0
End Sub
'Callback onAction
Sub policeColor(control As IRibbonControl, id As String, index As Integer)
'Call the macro that belongs to the label when you click one of the labels.
'Example: When you click the first label it runs the macro named "macro_1".
'On Error Resume Next
Application.Run "macro1_" & Format(index + 1, "00")
'On Error GoTo 0
End Sub
Sub macro_01()
'remplissage_jaune

With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 221, 0)
.Fill.Transparency = 0#
End With
End Sub

Sub macro_02()
'remplissage_rose

With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(228, 21, 106)
.Fill.Transparency = 0#
End With
End Sub

Sub macro_03()
'remplissage_vert
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(151, 191, 13)
.Fill.Transparency = 0#
End With
End Sub

Sub macro_04()
'remplissage_orange
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(240, 145, 0)
.Fill.Transparency = 0#
End With
End Sub

Sub macro_05()
'remplissage_bleu
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(52, 180, 228)
.Fill.Transparency = 0#
End With
End Sub

Sub macro_06()
'remplissage_pin
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(0, 81, 101)
.Fill.Transparency = 0#
End With
End Sub

Sub macro_07()
'remplissage_gris_fonce
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(112, 113, 115)
.Fill.Transparency = 0#
End With
End Sub

Sub macro_08()
'remplissage_gris_clair
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(217, 218, 219)
.Fill.Transparency = 0#
End With
End Sub

Public Sub macro1_01()
'texte jaune
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(255, 221, 0)
End Sub
Public Sub macro1_02()
'texte rose
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(228, 21, 106)
End Sub
Public Sub macro1_03()
'texte rose
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(151, 191, 13)
End Sub
Public Sub macro1_04()
'texte orange
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(240, 145, 0)
End Sub

Public Sub macro1_05()
'texte bleu
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(52, 180, 228)
End Sub
Public Sub macro1_06()
'texte pin
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(0, 81, 101)
End Sub
Public Sub macro1_07()
'texte gris fonce
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(112, 113, 115)
End Sub

Public Sub macro1_08()
'texte gris clair
Windows(1).Selection.TextRange.Font.Color.RGB = RGB(217, 218, 219)
End Sub

A noter que ce code fonctionne parfaitement pour Word et Excel.

Vous avez résolu votre problème avec VIC ? Faites-le savoir sur les réseaux sociaux !
Vulgarisation-informatique.com
Cours en informatique & tutoriels