[Formulaire] Mise en forme conditionnelle en VBA [Sources]

**léti07** · 12/10/2006, 11h43

bonjour à tous

Voila mon probleme,
mon formulaire est en mode continu et il affiche les données d'une même table.Je dois mettre une couleur de fond sur un de mes champs (qui est égal à une valeur saisie dans ma table)

et je n'y arrive pas

, il me mets la même couleur pour tous alors que chacun de mes champs à sa propre couleur.

voici mon code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim mabd As Database
Dim typ As DAO.Recordset
Set mabd = CurrentDb
Set typ = mabd.OpenRecordset("T_Type")
Dim x As Variant
Dim Ctrl As Control
 
Do Until typ.EOF
If (typ!IdType = Me.IdType) Then
    Me.CouleurType.BackColor = typ!CouleurType
End If
typ.MoveNext
Loop
typ.Close

Je pense que le probleme viens de ma boucle If mais j'ai essayé sous d'autre forme (For..Next, For each...Next, sans le Do, sans le If, etc...) mais je n'arrive pas a mettre une couleur sur mon champs par ligne.

J'espere que je suis assez clair sinon n'hesitez pas à me poser des questions.

Merci d'avance pour votre aide

**Arkham46** · 12/10/2006, 11h55

bjr,

il n'est pas possible d'agir sur les contrôles d'une ligne indépendamment des autres

seule solutions : la mise en forme conditionnelle
regarde dans les tutos, il y en a un

**léti07** · 12/10/2006, 12h05

j'ai deja regarder la mise en forme conditionnelle mais ca ne correspond pas à ce que je veux faire

**Tofalu** · 12/10/2006, 12h07

C'est la seule solution !

**léti07** · 12/10/2006, 12h21

Envoyé par Tofalu

C'est la seule solution !

peut etre mais ça correspond pas à ce que je veux

j'explique ce que je dois faire pour mon projet (enfin une partie)

Je dois mettre en place des statistiques
Et sur une de mes stats j'ai besoin de faire apparaitre une couleur de fond selon le type.
Pour cela j'avais créer une image Bitmap (qui était stocké dans ma table type) sur laquelle j'avais affecter une couleur, cela fonctionnais tres bien.

Mais mon client veux pouvoir choisir lui même sa couleur et il trouvait trop compliqué de double clické sur le champs et d'affecté une couleur par paint.

Donc je me suis dis que j'allais stocké le numéro de la couleur au lieu de l'image pour ensuite l'affecter sur mon champs.

Donc c'est pas possible comme ca

mais j'ai plus d'idée pour satisfaire mon client si quelqu'un à une idée sur comment faire je suis preneuse

**Tofalu** · 12/10/2006, 12h32

Je ne vois pas en quoi la mise en forme conditionnelle n'irait pas

Tu glisses une zone de texte en arrière plan et tu lui définit la mise en forme conditionnelle comme tu veux :

Exemple :

Expression : MonChamp="b"
Propriété :
Couleur de remplissage : marron
Activé : non

**léti07** · 12/10/2006, 13h56

Si je me trompe pas, on peux mettre que 3 conditions dans une mise en forme conditionnelle??
Alors qu'il m'en faudrait une dizaine et aussi que se soit variable en fonction du nombre de type.

Je suis un peu perdu la

**léti07** · 12/10/2006, 17h24

ce qui m'embete le plus c'est que j'ai besoin de conserver la couleur pour la reutiliser dans une requete.
Je m'explique:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
table type
idtype      nomtype     couleurtype
1             type1         rouge (ou 255)
2             type2         bleu
3             type3         vert
n             typen         n.....
 
ma requete :
idproduit  nomproduit  nomfournisseur  couleurtype
200          nom1          four1             rouge
222          nom2          four2             rouge
300          nom3          four1             vert

ma couleur doit etre afficher en arriere plan

ma 1er solution marchais bien, il m'embete mon client

c'est pourtant pas compliqué de double clické pour ouvrir paint
grrrrrr

**Arkham46** · 12/10/2006, 17h53

salut,

à tester pour mettre à jour une couleur de bitmap par le code
(ça marche sur mon pc, faut tester pour voir si c'est générique...)

j'ai créé un bitmap de 1x1 pixel, extrait sa valeur (c'est le tableau lOle) puis repéré la position des composantes de couleur qu'il suffit de changer pour obtenir un bitmap d'une autre couleur

Mettre ce code dans un module :

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
63
64
65
66
67
Option Compare Database
Option Explicit
 
'---------------------------------------------------------------------------------------
' Crée un bitmap OLE uni de 1*1 pixel
'---------------------------------------------------------------------------------------
' pTable      : Table contenant le champ OLE
' pField      : Champ OLE à créer
' pWhere      : Clause where indiquant quelle ligne mettre à jour
' pColor      : Couleur (ex : vbRed ou RGB(255,0,0))
'---------------------------------------------------------------------------------------
Public Sub CreateOLEColor(pTable As String, pField As String, pWhere As String, pColor As Long)
Dim lOle As Variant
Dim lOLEByte() As Byte
Dim lCpt As Integer
Dim lr As Long, lb As Long, lg As Long
Dim ldb As DAO.Database
Dim lrs As DAO.Recordset
lOle = Array(21, 28, 47, 0, 2, 0, 0, 0, 13, 0, 14, _
             0, 20, 0, 33, 0, 255, 255, 255, 255, 66, 105, _
             116, 109, 97, 112, 32, 73, 109, 97, 103, 101, 0, _
             80, 97, 105, 110, 116, 46, 80, 105, 99, 116, 117, _
             114, 101, 0, 1, 5, 0, 0, 2, 0, 0, 0, 7, 0, _
             0, 0, 80, 66, 114, 117, 115, 104, 0, 0, 0, 0, _
             0, 0, 0, 0, 0, 64, 0, 0, 0, 66, 77, 58, 0, _
             0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, 0, _
             1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 24, 0, 0, 0, _
             0, 0, 4, 0, 0, 0, 196, 14, 0, 0, 196, 14, _
             0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 255, 0, _
             0, 0, 0, 0, 0, 0, 0, 1, 5, 0, 0, 0, 0, _
             0, 0, 130, 173, 5, 254)
ReDim lOLEByte(UBound(lOle))
For lCpt = 0 To UBound(lOle)
    lOLEByte(lCpt) = CByte(lOle(lCpt))
Next
LongToRGB pColor, lr, lg, lb
lOLEByte(132) = CByte(lb)
lOLEByte(133) = CByte(lg)
lOLEByte(134) = CByte(lr)
Set ldb = CurrentDb
Set lrs = ldb.OpenRecordset("select [" & pField & "] from [" & pTable & "] where " & pWhere)
If Not lrs.EOF Then
    lrs.Edit
    lrs.Fields(pField).Value = lOLEByte
    lrs.Update
    lrs.Close
End If
Set lrs = Nothing
Set ldb = Nothing
End Sub
 
'---------------------------------------------------------------------------------------
' Conversion code couleur Long vers RGB
'---------------------------------------------------------------------------------------
' pLong     : Numéro de la couleur
' pRed      : Composante Rouge
' pGreen    : Composante Verte
' pBlue     : Composante Bleue
'---------------------------------------------------------------------------------------
Private Function LongToRGB(ByVal pLong As Long, pRed As Long, pGreen As Long, pBlue As Long) As Boolean
    On Error GoTo Gestion_Erreurs:
    pBlue = Int(pLong / 65536)
    pGreen = Int((pLong - (65536 * pBlue)) / 256)
    pRed = pLong - ((pBlue * 65536) + (pGreen * 256))
Gestion_Erreurs:
    If Err.number = 0 Then LongToRGB = True    ' Renvoie Vrai si pas d'erreur
End Function

puis pour mettre à jour la couleur du bitmap OLE :

Code :

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

CreateOLEColor "MaTable", "MonChampOLE", "MaValeur = MaCondition", MaCouleur

le bitmap créé fait 1x1 pixel
pas besoin de plus grand, il suffit de mettre le contrôle en mode d'affichage échelle pour que le pixel s'étale sur tout le contrôle

edit : ça marche sur access 97 et access 2003

**léti07** · 13/10/2006, 10h13

bonjour

j'ai essayer ton code mais il bloque sur

Code :

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

lrs.Fields(pField).Value = lOLEByte

pfield c'est mon objet ole a créer.
peux tu m'expliquait ce bout de code

merci d'avance

**Arkham46** · 13/10/2006, 10h30

quelle est le message d'erreur?

**léti07** · 13/10/2006, 10h51

il me met :

Code :

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

1
2
erreur d'execution 3167
l'enregistrement est supprimé

**Arkham46** · 13/10/2006, 12h04

ah? tu fais une suppression avant?
montre ton code.
à quel moment il est exécuté?

**léti07** · 13/10/2006, 12h13

voila mon code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Valider_Click()
 
Dim mabd As Database
Set mabd = CurrentDb
Dim typ As DAO.Recordset
Set typ = mabd.OpenRecordset("T_Type")
 
typ.Edit
CreateOLEColor "T_Type", "CouleurType", "idtype = idtype", Me.CouleurType.BackColor
typ!DesignationType = Me.DesignationType
typ.Update
 
End Sub

c'est peut etre le edit qui lui plait pas

**Arkham46** · 13/10/2006, 12h17

y a déjà un edit dans la fonction

tu es où? dans un formulaire?

si tu veux modifier le champ OLE de la ligne en cours, on peut rendre la fonction plus générique :

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
'---------------------------------------------------------------------------------------
' Crée un bitmap OLE uni de 1*1 pixel
'---------------------------------------------------------------------------------------
' pColor      : Couleur (ex : vbRed ou RGB(255,0,0))
'---------------------------------------------------------------------------------------
Public Function CreateOLEColor(pColor As Long) As Variant
Dim lOle As Variant
Dim lOLEByte() As Byte
Dim lCpt As Integer
Dim lr As Long, lb As Long, lg As Long
lOle = Array(21, 28, 47, 0, 2, 0, 0, 0, 13, 0, 14, _
             0, 20, 0, 33, 0, 255, 255, 255, 255, 66, 105, _
             116, 109, 97, 112, 32, 73, 109, 97, 103, 101, 0, _
             80, 97, 105, 110, 116, 46, 80, 105, 99, 116, 117, _
             114, 101, 0, 1, 5, 0, 0, 2, 0, 0, 0, 7, 0, _
             0, 0, 80, 66, 114, 117, 115, 104, 0, 0, 0, 0, _
             0, 0, 0, 0, 0, 64, 0, 0, 0, 66, 77, 58, 0, _
             0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, 0, _
             1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 24, 0, 0, 0, _
             0, 0, 4, 0, 0, 0, 196, 14, 0, 0, 196, 14, _
             0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 255, 0, _
             0, 0, 0, 0, 0, 0, 0, 1, 5, 0, 0, 0, 0, _
             0, 0, 130, 173, 5, 254)
ReDim lOLEByte(UBound(lOle))
For lCpt = 0 To UBound(lOle)
    lOLEByte(lCpt) = CByte(lOle(lCpt))
Next
LongToRGB pColor, lr, lg, lb
lOLEByte(132) = CByte(lb)
lOLEByte(133) = CByte(lg)
lOLEByte(134) = CByte(lr)
CreateOLEColor = lOLEByte
End Function

puis dans le formulaire :

Code :

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

me!TOnchampOLE = CreateOLEColor(Me.CouleurType.BackColor)

**léti07** · 13/10/2006, 12h37

je viens de m'apercevoir que je l'ai pas mis au bon endroit

je suis dans un formulaire ( qui doit mettre à jour ma table T_Type)
et le code est :

Code :

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

1
2
3
4
5
Private Sub Palette_Click()
Me.couleur = ShowColor  
Me!CouleurType = CreateOLEColor(Me.couleur.BackColor)
Me.CouleurType.Requery
End Sub

showcolor est une fonction qui m'ouvre la palette (trouver dans la faq

)

j'ai reexcuter mon formulaire avec ton nouveau code et j'ai ce message qui apparait (sur CreateOLEColor):

Code :

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

1
2
erreur de compilation :
argument non facultatif

j'ai encore du oublier quelque chose

**Arkham46** · 13/10/2006, 12h53

CouleurType c'est ton champ OLE?

(le requery il fait quoi?)

"argument non facultatif" c'est bizarre y a qu'un argument à la nouvelle fonction (erreur de copier-coller?)

**léti07** · 13/10/2006, 13h58

CouleurType c'est mon champs OLE

le requery il me servait à mettre à jour ma couleur mais je peux l'enlever maintenant

et tu avais resond j'avais une erreur de copier /coller

(la déclaration était en double)

bon j'ai plus de message d'erreur

mais (il en faut toujours un

) , il me crée bien la taille de mon champs ole mais il ne m'affecte pas ma couleur