Autres CreatorRibbonX palette color pour DUDU2

Function CreateIcon16(control As IRibbonControl, Optional InSquare As Boolean = False)
    'archive SCR disque 3:CreatorRibbonX imageMso v 2.2 by patricktoulon
   
    Dim Shap As Shape, carre As Shape, grp As ShapeRange, groupedShape As Shape
     Set bt = CommandBars(1).Controls.Add(msoControlButton, , , , True)
    Application.CutCopyMode = False 'vide le clip
    DoEvents
   
    If InSquare Then
    ' Crée un carré blanc
    Set carre = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 17, 17)
    carre.Fill.Transparency = 1
    carre.Line.Visible = msoFalse
    End If
   
    ' Crée un cercle avec la couleur  (la valeur est dans le control.tag injecté)
    Set Shap = ActiveSheet.Shapes.AddShape(msoShapeOval, 0, 0, 16, 16)
    Shap.Fill.ForeColor.RGB = Val(control.Tag)
    Shap.Line.Visible = msoFalse
   
    If InSquare Then
    'centre le rond sur le carré
    x = (carre.Width - Shap.Width) / 2
    y = (carre.Height - Shap.Height) / 2
    Shap.Left = carre.Left + x
    Shap.Top = carre.Top + y
   
   
    ' Regroupe les 2 formes
    Set grp = ActiveSheet.Shapes.Range(Array(Shap.Name, carre.Name))
    Set groupedShape = grp.Group
   
    ' Nomme le groupe
    groupedShape.Name = control.ID
    'les  2 shapes ne fonct plus qu'une  et un group est une shape a part entière
    'on peut donc copier cette shape
    groupedShape.CopyPicture 'pas bitmap sinon on a pas la transparence
   groupedShape.Delete
   Else
   'si on la met pas dans un carré
   Shap.Name = control.ID
   Shap.CopyPicture
   Shap.Delete
   End If
 
   'il nous reste plus qu'a coller sur le bouton temporaire de la commandbars(1)
    'avec la fonction native pasteFace
    On Error Resume Next
    bt.PasteFace
    On Error GoTo 0
   
    ' Retourne le .picture du bouton de la commandbarre
    Set CreateIcon16 = bt.Picture
   
End Function