Mise en forme conditionnelle

**crisjoce** · 27/11/2015, 11h02

Bonjour

Je souhaiterais faire une mise en forme conditionnelle.
j'ai regarder le forum sans reussir.

si dans la colonne B je trouve une cellule avec une couleur xx
je mets cette meme couleur dans la cellule A et de C a G

Nom : Capture.JPG
Affichages : 610
Taille : 76,9 Ko

Nom : Capture.JPG
Affichages : 610
Taille : 76,9 Ko

merci

**Daniel.C** · 27/11/2015, 11h10

Bonjour,

Tu peux changer la couleur des cellules par macro, mais tu ne peux pas faire une mise en forme conditionnelle basée sur une couleur. Si ta couleur xx est changée en yy, la couleur des cellules A et C:G ne sera pas modifiée automatiquement. Il faudra que tu exécutes la macro à chaque fois.

**crisjoce** · 27/11/2015, 11h21

Bj daniel

as tu une idee pour ecrire la macro, si tu trouve en B la couleur rouge
tu copie la meme couleur sur la ligne correspondnate en A et c a G.

je tourne depuis un moment

**Daniel.C** · 27/11/2015, 12h29

Code :

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

1
2
3
4
5
6
7
8
Sub Couleur()
    Dim C As Range
    For Each C In Range("B1", Cells(Rows.Count, 2).End(xlUp))
        If C.Font.Color = 255 Then
            Cells(C.Row, 1).Resize(, 7).Font.Color = 255
        End If
    Next C
End Sub

**Marc-L** · 27/11/2015, 12h58

Bonjour.

Code :

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

1
2
3
4
5
6
7
8
Sub Demo()
         Dim Rg As Range
         Application.ScreenUpdating = False
    For Each Rg In ActiveSheet.UsedRange.Columns("A:G").Rows
          If Rg.Cells(2).Font.ColorIndex = 3 Then Rg.Font.ColorIndex = 3
    Next
         Application.ScreenUpdating = True
End Sub

______________________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

______________________________________________________________________________________________________

Je suis Paris

**crisjoce** · 27/11/2015, 13h56

cela ne fonctionne pas,,ci joint le debut de la macro
a laquelle je voudrais completer

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
Private Sub CommandButton1_Click()
 
Dim I As Integer, y As Integer
    Set sh = Sheets("Feuil1")
    y = sh.[B:B].Find("*", , , , xlByRows, xlPrevious).Row
 
 
    With Me.ListBox1
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
            y = y + 1
            sh.Range("B" & y).Value = .List(I)
 
            With sh.Range("B" & y).Font
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = -0.249977111117893
    With sh.Range("B" & y).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10066431
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End With
    End If
    Next I

LA COULEUR SE MET BIEN EN B.. ET JE SOUHAITERAIS QUE LA CELLULE DE GAUCHE PRENNE LA MEME
ET QUE LES 5 DE ROITE IDEM

**Theze** · 27/11/2015, 14h18

Bonjour,

Transforme cette ligne :

Code :

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

1
2
 
sh.Range("B" & y).Interior

en celle là :

Code :

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

1
2
 
With sh.Range("A" & y & ":G" & y).Interior

**crisjoce** · 27/11/2015, 14h44

IL NE ME REMPLI QUE LA CELLULE A et la E

**Daniel.C** · 27/11/2015, 14h49

cela ne fonctionne pas

Ca dépend de ta nuance de rouge, aussi.

**crisjoce** · 27/11/2015, 15h04

j'ai changer la couleur et voila le resultat

Nom : Capture.JPG
Affichages : 460
Taille : 58,9 Ko

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
Private Sub CommandButton1_Click()
Dim I As Integer, y As Integer
    Set sh = Sheets("Feuil1")
    y = sh.[B:B].Find("*", , , , xlByRows, xlPrevious).Row
 
 
    With Me.ListBox1
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
            y = y + 1
            sh.Range("B" & y).Value = .List(I)
            With sh.Range("B" & y).Font
            .Name = "Calibri"
            .Size = 9
            .Bold = True
            .ThemeColor = xlThemeColorLight2
           .TintAndShade = 0
    With sh.Range("A" & y & ":G" & y).Interior
        .Pattern = xlSolid
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
 
       End With
    End With
      End If
    Next I

je souhaterais que seulement la ligne 12 soit colorée.

**crisjoce** · 27/11/2015, 15h30

j'ai modifie "G" par J et cela a bien colorée les cellules H I et J

car ces cellules sont vides

les cellules C,D,F,et G il y a des donnees dedans

**Theze** · 27/11/2015, 15h35

Si "y" vaut 12, cette ligne de code :

Code :

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

1
2
 
sh.Range("A" & y & ":G" & y).Interior

ne peut que faire référence à A12:G12
Dans ton dernier code, je ne vois plus ".Color = 10066431" ?

**crisjoce** · 27/11/2015, 15h45

voici le resultat et le code complet du fichier

Nom : Capture.JPG
Affichages : 475
Taille : 57,5 Ko

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Private Sub CommandButton1_Click()
Dim I As Integer, y As Integer
    Set sh = Sheets("Feuil1")
    y = sh.[B:B].Find("*", , , , xlByRows, xlPrevious).Row
 
 
    With Me.ListBox1
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
            y = y + 1
     sh.Range("B" & y).Value = .List(I)
     With sh.Range("A" & y & ":G" & y).Interior
        .Pattern = xlSolid
       .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
'          .Color = 10066431
 
       End With
            With sh.Range("B" & y).Font
            .Name = "Calibri"
            .Size = 9
            .Bold = True
            .ThemeColor = xlThemeColorLight2
            .TintAndShade = 0
End With
End If
Next I
 
 
 
 
 
    With Me.ListBox2
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        sh.Range("B" & y).Value = .List(I)
        With sh.Range("B" & y).Font
            .Name = "Calibri"
            .Size = 9
            .Bold = True
            .ThemeColor = xlThemeColorLight2
            .TintAndShade = 0
        End With
        End If
        Next I
    End With
 
    With Me.ListBox3
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        sh.Range("B" & y).Value = .List(I)
        With sh.Range("B" & y).Font
            .Name = "Calibri"
            .FontStyle = "Normal"
            .Size = 9
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = -0.249977111117893
        End With
        End If
    Next I
    End With
 
 
 With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
End With
 
Range("G12").Formula = "=VLOOKUP(B12,tableau2,2)"
Range("C12:G12").HorizontalAlignment = xlCenter
Range("C12:G12").VerticalAlignment = xlCenter
Range("G12").AutoFill Range("G12:G" & Range("B65536").End(xlUp).Row)
 
Range("F12").Formula = "=SUM(RC[-2]*RC[-1])"
Range("F12").AutoFill Range("F12:F" & Range("B65536").End(xlUp).Row)
Range("D12") = 3.75
Range("D12").AutoFill Range("D12:D" & Range("B65536").End(xlUp).Row)
Range("C12") = "h"
Range("C12").AutoFill Range("C12:C" & Range("B65536").End(xlUp).Row)
 
With Application
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .CutCopyMode = False
        .ScreenUpdating = True
End With
 
 
  For I = 0 To Me.ListBox1.ListCount - 1
  Me.ListBox1.Selected(I) = False
  Next I
  For I = 0 To Me.ListBox2.ListCount - 1
  Me.ListBox2.RemoveItem 0
  Next I
  For I = 0 To Me.ListBox3.ListCount - 1
  Me.ListBox3.RemoveItem 0
  Next I
  Me.ListBox1.SetFocus
End With
End Sub

**Theze** · 28/11/2015, 09h11

Bonjour,

J'ai plus ou moins tenté de reproduire ton classeur et j'ai bien les cellules A à G sur une seule ligne qui se colorent (test que sur une ListBox) !
Poste ton classeur qu'on puisse faire un test.
Dans un premier temps, mets en commentaire le code des autres ListBox afin que ce soit juste la première qui travaille.
Dans ton code tu as une ligne qui risque de provoquer une erreur :

Code :

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

1
2
 
y = Sh.[B:B].Find("*", , , , xlByRows, xlPrevious).Row

tu utilises la méthode Find sans contrôler la valeur de retour, si c'est égal à Nothing, ça plante. Bon, il est vrai que tu aura au moins la présence de la ligne d'entêtes qui fera en sorte qu'une cellule sera trouvée mais malgré tout, je verrai plutôt ceci :

Code :

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

1
2
3
4
5
 
Dim Cel As Range
Set Cel = Sh.[B:B].Find("*", , , , xlByRows, xlPrevious)
If Cel Is Nothing Then Exit Sub
y = Cel.Row

**crisjoce** · 01/12/2015, 10h07

Bonjour

Voici le fichier excel.

je souhaiterais aussi lorsque j'ai oublie une valeur , inserer une ligne vierge en B.. pour une des rubriques
lancer l'userform, faire un nouveau choix, et que la valeur selectionnée s'inscrive en B.. sur la ligne vierge que je viens de creer.
en cliquant sur le bouton Rajout.

merci
cris
Nom : Capture.JPG
Affichages : 464
Taille : 72,0 Ko

Nom : Capture.JPG
Affichages : 464
Taille : 72,0 Ko

**crisjoce** · 01/12/2015, 15h36

j'ai trouve une autre solution, avec la mise
en forme conditionnelle, qui fonctionne tres bien.

il ne me reste que le second probleme a regler.

je souhaiterais aussi lorsque j'ai oublie une valeur , inserer une ligne
lancer l'userform, faire un nouveau choix, et que la valeur s'inscrive dans la ligne vierge que je viens de creer.
en cliquant sur le bouton Rajout.

merci
cris

**crisjoce** · 02/12/2015, 10h55

Je viens de reformuler mon post

merci
chris

Mise en forme conditionnelle [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager