Discussion :

[Papoune82]

Bonjour à tous

Mon problème est le suivant.

Dans un UserForm, je voudrais donner la possibilité à un utillisateur de changer la couleur de fond (backcolor) d'un TextBox avec le composant xlDialogPatterns

le code suivant me laisse bien choisr la couleur mais il me renvoie une erreur 380 lorsque je valide la couleur.

txtFormatMessage.BackColor = Application.Dialogs(xlDialogPatterns).Show

Je vous remercie d'avance de votre aide

Papoune82

[gFZT82]

Bonjour,

Je suis comme toi, je ne sais pas affecter une couleur à une TextBox avec une boite de dialogue intégrée car le choix de couleur que j’effectue à l’aide de Application.Dialogs(xlDialogPatterns) s’applique à la cellule sélectionnée dans la feuille active.

Je fais donc une bidouille pour contourner le problème.
1. Je mémorise la couleur de la cellule sélectionnée.
2. J’applique la couleur souhaitée pour la TextBox à cette cellule (via Application.Dialogs(xlDialogPatterns)
3. J’applique la couleur à la TextBox en lui affectant la couleur de la cellule
4. Je rends à la cellule sa couleur initiale.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Range("A1").Select
Memo = Range("A1").Interior.Color
Application.Dialogs(xlDialogPatterns).Show
Me.TextBox1.BackColor = Range("A1").Interior.Color
Range("A1").Interior.Color = Memo

Pas très académique !

Cordialement.

[fring]

Bonjour,

La boîte de dialogue "xlDialogPatterns" sert à modifier la couleur de la cellule active et il n'est pas possible de récupérer directement la couleur sélectionnée.
Mais il est possible de bricoler un peu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim CelCol As Long, x As Boolean
 
'mémorisation de la couleur initiale de la cellule active
CelCol = ActiveCell.Interior.Color
 
'affichage de la boîte de dialogue
x = Application.Dialogs(xlDialogPatterns).Show
 
'si on annule le choix de la couleur, x renvoit "False"
'sinon x renvoit "True" et la cellule active prendra la couleur sélectionnée
If x = True Then
    'couleur de la textbox identique à la cellule active
    Me.TextBox1.BackColor = ActiveCell.Interior.Color
    'couleur de la cellule active initiale
    ActiveCell.Interior.Color = CelCol
End If

[Edit]
oups réponse donnée entre temps par gFZT82

[patricktoulon]

bonjour

peu etre une palette perso comme ceci

'dans le module du userform

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim couleur As Long
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
TextBox1.BackColor = choixColor(Me, TextBox1.BackColor)
End If
End Sub

'dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
 
'***************************************************************************************
'*                      DIALOGUE CHOIX DE COULEUR                                      *
'***************************************************************************************
Option Explicit
 
' Comm Dialog Couleur
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
' Type pour boîte dialogue couleurs
Private Type ChooseColor
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
 
 
'---------------------------------------------------------------------------------------
' Boîte dialog pour choix couleur
'---------------------------------------------------------------------------------------
'Handle    : Handle du parent de la boîte de dialogue
'
' Renvoie la couleur du control si on annule ou si aucune couleur n'est choisie
'---------------------------------------------------------------------------------------
Public Function choixColor(uf As Object, oldcouleur As Long) As Long
' Structure contenant les informations nécessaire à l'API
    Dim lcc As ChooseColor
    Dim handle As Long
   '***************************************************************************************************************
 ' ici on determine le handle par la classe de frame en testant la version de l'application ( DE EXCEL97 A 2007)*
  handle = FindWindow("Thunder" & IIf(Application.Version Like "8*", "0*", "D") & "Frame", uf.Caption)         '*
 
    ' Tableau statique pour conserver les couleurs personnalisées
    Static lCustomColors() As Byte
    On Error GoTo gestion_erreurs
    ' Redimensionne le tableau sans supprimer son contenu
    ReDim Preserve lCustomColors(0 To 16 * 4 - 1) As Byte
    lcc.lpCustColors = StrConv(lCustomColors, vbUnicode)    ' Couleurs personnalisées
    lcc.lStructSize = Len(lcc)    ' Taille de la structure
    lcc.hWndOwner = handle    ' Handle du parent
    lcc.flags = 0              ' Pas de flags particuliers
    If ChooseColor(lcc) <> 0 Then
        ' On a choisi une couleur
        ' Renvoie la couleur choisie
        choixColor = lcc.rgbResult
        ' Stocke les couleurs personnalisées pour la prochaine exécution
        lCustomColors = StrConv(lcc.lpCustColors, vbFromUnicode)
    Else
        ' Aucune couleur choisie, on renvoie -1
        choixColor = oldcouleur
    End If
gestion_erreurs:
    If Err.Number <> 0 Then Exit Function    ' Renvoie -1 si erreur
End Function

au plaisir