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

patricktoulon

XLDnaute Barbatruc
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
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

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

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

XLDnaute Barbatruc
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
VB:
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

XLDnaute Barbatruc
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
VB:
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
Code:
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

XLDnaute Barbatruc
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)
VB:
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
 

Staple1600

XLDnaute Barbatruc
Re

J'ai ressorti ce truc de mes archives, histoire de jouer avec les crayons de couleur ;)
VB:
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

XLDnaute Barbatruc
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
VB:
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
 

Staple1600

XLDnaute Barbatruc
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) ;)
 

Modeste geedee

XLDnaute Barbatruc
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
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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
 

Roblochon

XLDnaute Accro
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)
VB:
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:
Code:
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+
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bon ca y est on avance mon bouton fonctionne

alors je lance la sub test ça me met le bouton dans le menu outils (ca c'est ok)
je click sur userform1 dans VBE puis sur outils puis sur couleurs( ca c'est ok)
ma palette s'affiche ( ca c'est ok)
le click sur son bouton ok de la palette devrait me mettre le commandbutton1 en couleur choisie ( pas ok) ca le fait pas


mais on avance quand même
 

Fichiers joints

Roblochon

XLDnaute Accro
Re,

Oui, excusez-moi, j'avais retapé à la volée sans tester.
Voici qui fonction
Le module général:
Code:
Option Explicit
Public LeBouton As clsControlEvent
Sub test()
    Dim CTRL As CommandBarButton
    Dim evt As clsControlEvent
    Set CTRL = Application.VBE.CommandBars("Tools").Controls("Couleurs")
    If Not CTRL Is Nothing Then CTRL.Delete
    ' N'ai pas envie de reseter ma barre d'outils
    'Application.VBE.CommandBars("Tools").Reset
    Set CTRL = Application.VBE.CommandBars("Tools").Controls.Add(msoControlButton)
    With CTRL
        .Caption = "Couleurs"
        .BeginGroup = True
        .FaceId = 25
        .OnAction = "showpalette"
    End With

    Set evt = New clsControlEvent
    Set evt.ControlEvent = Application.VBE.Events.CommandBarEvents(CTRL)
    Set LeBouton = evt
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
VB:
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
A la prochaine

[Edit] Bing! Colllision.
 

Fichiers joints

Roblochon

XLDnaute Accro
Re,
Re bing! euh patrick, j'ai employé cette solution pour éviter le reset de mon menu outils (que d'ailleurs vous ne devriez pas mettre dans un fichier exemple).

C'est normal quand une collection ne trouve pas un item demandé.

soit vous mettez un on error resume next avant soit vous reseter votre menu outils
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas