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
 

patricktoulon

XLDnaute Barbatruc
Bonjour Staple 1600

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

demo2.gif
 

Pièces jointes

  • commandbar add vbe .xlsm
    15.9 KB · Affichages: 17

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

patricktoulon

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

Pièces jointes

  • diverse facon d'afficher une palette couleur pourun userform.xls
    79 KB · Affichages: 19

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:

Hasco

XLDnaute Barbatruc
Repose en paix
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:

Discussions similaires

Statistiques des forums

Discussions
311 716
Messages
2 081 848
Membres
101 826
dernier inscrit
dododu89