Autres [Résolu]ajouter une palette couleur dans le menu VBE

[patricktoulon]

bonjour a tous
je ne sais pas pour vous mais quand je construit mes userforms et que je met de la couleur je n'ai que les 56 couleur de base (beurk!!!)

j'aimerais me faire un tout petit complément
un bouton dans la commandbar de VBE (l’éditeur de code vba)
qui m'afficherait un userform avec une palette plus importante de couleur (ca c'est bon j'ai en plusieurs méthodes)
le choix de la couleur s'inscrirait dans un textbox dans cette palette et un simple copier coller dans la propriété d'un control ou userform en construction manuel me suffirait

donc pour commencer

1. comment ajoute on un bouton dans la commandbars VBE
2. un userform est il possible qu'il soit affiché en mode édition dans VBE
3. comment stiker la couleur choisi dans la dite palette couleur

 

[Staple1600]

Bonsoir le fil

patricktoulon
En lisant ton fil, j'ai pensé à ce bel ouvrage de Dranreb

Élaboration et utilisation de jeux de couleurs.

Mise au point facile de jeux de couleurs pour UserForm, Shape et cellules, voire images calculées. Possibilité de capturer un pixel n'importe où sur l'écran. Module de classe Couleur pour utilisation dans d'autres projets VBA.

www.excel-downloads.com

Peut-être y puiseras-tu quelque substantielle moelle ?

PS: Sinon ton titre de post n'est guère parlant, non ?
Surtout que tu n'es pas un newbie sur les forums Exceliens

 

[patricktoulon]

re merci Staple 1600
c'est vraiment pas mal
j'ai moi même déjà quelque outils similaires
je vais regarder de plus près



sachant que j'ai deja une fonction qui m'ouvre une boite existante de dialog couleur plus importante et modifiable ET!! que je peux intercepter et en récupérer la couleur choisi sans passer par une cells
celle ci
le msgbox renvoie bien la couleur j 'intercepte donc bien le return

Sub test()
    Dim lcolor As Long
    With Application.Dialogs(xlDialogEditColor)
        If .Show(2, 255, 0, 0) = True Then MsgBox ActiveWorkbook.Colors(2)
    End With
    ActiveWorkbook.ResetColors
End Sub

le tout c'est de pouvoir lancer en mode edition VBE ,choisir,stoker pour le coller dans backcolor ou forecolor ou bordercolor dans vbe pour un control

vraiment pas mal le fichier de dranreb

 

[patricktoulon]

bonjour a tous
mes doutes s’avèrent être légitimes du moins c'est ce qu'il en ressort de ce test

ajout d'un bouton dans le menu outils dans VBE

Sub test()
    Dim CTRL
    Set CTRL = Application.VBE.CommandBars("Tools").Controls.Add(1)
    With CTRL
        .Caption = "Couleurs"
        .BeginGroup = True
        .FaceId = 25
        .OnAction = "showpalette"
    End With
End Sub

Sub showpalette()
    Dim lcolor As Long
    With Application.Dialogs(xlDialogEditColor)
        If .Show(2, 255, 10, 10) = True Then MsgBox ActiveWorkbook.Colors(2)
    End With
    ActiveWorkbook.ResetColors
End Sub

en effet la palette ne s'affiche pas ,j'ai mis un msgbox , il n’apparaît pas il est clair que la sub palette n'est pas appelée
peut être que ce que je souhaite n'est pas possible

 

[Staple1600]

Bonjour le fil, patricktoulon

patricktoulon
Pourtant sur l'exemple initial (par delà les océans), cela fonctionne
(en tout cas, sur mon XL2K13 32bit sous W10 64bits)

Sub ColorPaletteDialogBox()
Dim lcolor As Long
If Application.Dialogs(xlDialogEditColor).Show(10, 0, 125, 125) = True Then
  'user pressed OK
  lcolor = ActiveWorkbook.Colors(10)
  ActiveCell.Interior.Color = lcolor
Else
  'user pressed Cancel
End If
End Sub

 

[patricktoulon]

Bonjour Staple 1600

le dialog fonctionne oui lancé comme ca mais par un bouton sup dans la commandbars de VBE non
demo

 

[Staple1600]

Re

J'ai ressorti ce truc de mes archives, histoire de jouer avec les crayons de couleur

Spoiler: Spéciale dédicace à Gribouille (barbatruc!) (remember Les Visteurs du Mercredi

Option Explicit
Private Declare Function ChooseColor_Dlg Lib "comdlg32.dll" _
    Alias "ChooseColorA" (pcc As CHOOSECOLOR_TYPE) As Long

Private Type CHOOSECOLOR_TYPE
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Const CC_ANYCOLOR = &H100
Private Const CC_ENABLEHOOK = &H10
Private Const CC_ENABLETEMPLATE = &H20
Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1
Private Const CC_SHOWHELP = &H8
Private Const CC_SOLIDCOLOR = &H80
Sub Gribouillage()
    Dim CC_T As CHOOSECOLOR_TYPE, Retval As Variant
    Static BDF(16) As Long
    BDF(0) = RGB(0, 255, 0)     'first defined color
    BDF(1) = RGB(255, 0, 0)     'second defined color
    BDF(2) = RGB(0, 0, 255)     'third defined color
    With CC_T
        .lStructSize = Len(CC_T)
        .flags = CC_RGBINIT Or CC_ANYCOLOR Or CC_FULLOPEN Or _
        CC_PREVENTFULLOPEN
        .rgbResult = RGB(0, 255, 0)
        .lpCustColors = VarPtr(BDF(0))
    End With
    Retval = ChooseColor_Dlg(CC_T)
    If Retval <> 0 Then
        '/////////////// ajout pour test
        ActiveCell.Interior.Color = CC_T.rgbResult
        With ActiveSheet.Shapes.AddShape(1, 80, 80, 237, 80)
        .Fill.ForeColor.RGB = CC_T.rgbResult
        End With
        '/////////////// fin ajout pour test
    End If
End Sub

 

[patricktoulon]

re
oui je l'ai celle ci la ChooseColor ,je l'ai dans mes archives sous deux formes différente

je l'ai abandonné y a quelques années au profil de la dialog native qui offre les 3 mode palette (palette,colorpiker,3 petit combo )avec si peu de code et sans faire appel aux api
pour activer le colorpicker il faut metre 1 dans au moins un des 3 derniers argument


tiens puisqu'elle te plait voila la 2d version ultra simplifiée de choose_color en 32 bits

Private Declare Function ChooseColorA& Lib "comdlg32.dll" (pChoosecolor As CHOOSECOLOR)
Private Declare Function GetActiveWindow Lib "user32" () As Long

Private Type CHOOSECOLOR
    lStructSize As Long: hwndOwner As Long: hInstance As Long: rgbResult As Long: lpCustColors As Long
    flags As Long: lCustData As Long: lpfnHook As Long: lpTemplateName As String
End Type

Private Function ColorDlg&()
      Dim CCR As CHOOSECOLOR: ColorDlg = -1
    With CCR
        .lStructSize = Len(CCR): .hwndOwner = GetActiveWindow
        .rgbResult = dColor: .lpCustColors = VarPtr(&HFFFFFF): .flags = &H101
    End With
    If ChooseColorA(CCR) Then ColorDlg = CCR.rgbResult
End Function

Private Sub CommandButton1_Click()
    Dim i As Byte, NewColor&
    NewColor = ColorDlg
    If NewColor <> -1 Then Me.CadreColor1.BackColor = NewColor
End Sub

 

[patricktoulon]

non mon problème se situe au niveau du bouton qui ne déclenche pas showpalette

 

[Staple1600]

Re

Ce n'est pas qu'elle me plaise.
[humour de fin de semaine]
C'est simplement que nous sommes samedi, qu'ici il pleuvouille et que quitte à dénaturer Excel de sa fonction première (être un tableur) autant le faire en couleur et en variant les moyens de le faire.
[/humour]

Merci pour la version ultrasimplifiée.
(je mets cela dans mes archives, ça pourra resservir à la prochaine séance de coloriage)

 

[patricktoulon]

re

tiens tout droit de mes archives 2009
diverses façon d'afficher une palette couleur et interception du return pour les natives c'est vieux vieux vieux


sinon tu n'a pas une idée du probleme dans VBE
ou au moins si c'est possible

 

[Modeste geedee]

Bonsour®

bonjour a tous
je ne sais pas pour vous mais quand je construit mes userforms et que je met de la couleur je n'ai que les 56 couleur de base (beurk!!!)

je ne vois nulle part dans ton profil ou ta question la version Excel que tu utilises ... ?
avant EXCEL 2007 aucune possibilité d'avoir plus de 256 couleurs simultanées !

au dela de EXCEL 2007 et plus récents
les userforms autorisent dans leurs propriétés BackColor et ForeColor l'usage des codes RGB ( i.e. 1 à 16 millions de code couleur différents)

Private Sub UserForm_Click()
Randomize
Me.BackColor = RGB(Rnd() * 256, Rnd() * 256, Rnd() * 256)
DoEvents
End Sub

 

[patricktoulon]

bonjour Modeste geedee
j'utilise 2007 et 2013

mon problème réside a faire fonctionner le bouton supplémentaire dans le menu outils dans VBE qui devrait m'ouvrir la palette couleur
et cela quand je suis en mode édition bien sur

 

[Hasco]

bonjour,

Cela nécéssite une module de classe style (nommée ci-dessous clsControlEvent:
(ne pas oublier d'activer Microsoft Visual Basic for Applications Extensibility x.xx)

Option Explicit
Public WithEvents ControlEvent As CommandBarEvents

Private Sub ControlEvent_Click(ByVal Control As Object, Handled As Boolean, CancelDefault As Boolean)
    Application.Run Control.OnAction
    Handled = True
    CancelDefault = True
End Sub

Puis dans le code de création du bouton:

Sub test()
    Dim CTRL
     Dim evt as clsControlEvent

    Set CTRL = Application.VBE.CommandBars("Tools").Controls.Add(1)
    With CTRL
        .Caption = "Couleurs"
        .BeginGroup = True
        .FaceId = 25
        .OnAction = "showpalette"
    End With
  
Set evt = New clsControlEvent
        Set evt.ControlEvent = Application.VBE.Events.CommandBarEvents(cbButton)


End Sub

Wouah! y a des années que j'ai pas fait ça. Espérons que ça marche

A+

 

[patricktoulon]

Bonjour Roblochon
ben non ca marche pas j'ai pourtant corrigé cbButton vers CTRL

voir commentaire aussi pour cbcontrol dans la classe