Changer la backcolor d'un textbox avec XLDialogPatterns

Version imprimable

08/03/2012, 13h20
Papoune82

Changer la backcolor d'un textbox avec XLDialogPatterns

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 :roll:

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

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

Je vous remercie d'avance de votre aide

Papoune82
08/03/2012, 15h56
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:

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.

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:

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

heu

bonjour

peu etre une palette perso comme ceci

'dans le module du userform

Code:

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:

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