Autres CreatorRibbonX palette color pour DUDU2

[patricktoulon]

Bonsoir @Dudu2
J’ai pu dézipper une archive et j'ai retrouvé les deux exemples
Le premier avec les images externes et l'autre intégrées
J’ai dû les updater car il n'y avait pas d'events click
Par contre je n'ai plus le code couleur des images j'ai donc mis dans le tag 1,2,3,4,5...10
tu peux faire un array si tu les a encore sans devoir revenir sur le xml
Voilà elles ont le même rendu toutes les deux

je regarde ton xml

 

[Dudu2]

Bonjour @patricktoulon,
Je l'ai fait avec une Shape Rectangle / Carré parce que c'est ce qui m'a paru le plus simple et aussi pour faire un code complètement différent du tien pour les raisons que tu connais (utilisation libre pour moi ou tout autre utilisateur). L'affichage de la palette est immédiat donc a priori ça ne le pénalise pas même si ton code serait a priori plus performant.

 

[Dudu2]

si tu le fait par une autre shape carrée + des copy paste a répétition , autant le faire direct dans la createshape non?

Ok, je l'ai amélioré selon ta remarque, en évitant la création d'une copie de la Shape si elle est temporaire.

 

[patricktoulon]

Bonjour @Dudu2
OK mais ta pas comprit ma remarque en fait
regarde

Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.

Accepter les cookies de tiers

Donc comme là on fait des ronds j'ai mis le square en optional
à n'utiliser qu’en cas de shapes ne remplissant pas 4 côtés égaux
Et voilà terminé l'usine a gaz pour 10 petits boutons
la fonction CreateIcon16

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

qu'est-ce que tu veux de plus