[XL-2007] Mise en forme cellules suivant condition [Résolu]

[chris09300]

Bonjour
j'ai un tableau de U3 a Y67,dans U3 a U67, j'ai des valeurs 7101 7102 etc
je souhaiterais si les cellules W3 - X3 = 1 semaine mettre la cellules U3 de couleur 65535 jaune.
si W3 - X3 = 2 semaines cel U3= col 10092390 vert
si W3 - X3 = 3 semaines cel U3= col 16777062 bleu clair
si W3 - X3 = 4 semaines cel U3= col 12497879 gris
a integrer dans mon code ci dessous:

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
Private Sub CommandButton2_Click()
Dim DerLigS As Long
Dim MaRech As Range, CelFin As Range
Application.ScreenUpdating = False
 
If Me.Numero.Value <> "" Then
    With Sheets("AR-Base")
        DerLigS = .Cells(.Rows.Count, 21).End(xlUp).Row
        Set MaRech = .Range("U3:U" & DerLigS).Find(Me.Numero.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not MaRech Is Nothing Then
            'On décale les cellules à partir de C vers la droite
            '.Range("C" & MaRech.Row).Insert xlShiftToRight
            'La dernière cellule de la ligne MaRech.Row
            'Set CelFin = .Cells(MaRech.Row, .Columns.Count).End(xlToLeft)
            'En B on insère la formule
            '.Range("V" & MaRech.Row).Formula = "=CountA(V" & MaRech.Row & ":" & CelFin.Address(0, 0) & ")"
            Set CelFin = Nothing
            'On écrit en C notre texte et on applique la mise en forme
            With .Range("W" & MaRech.Row)
                .Value = CDate(DTPicker1.Value)
                .Font.Name = "Arial"
                .Font.Size = 12
                .Borders.LineStyle = xlContinuous
            End With
            With .Range("V" & MaRech.Row)
                .Value = Me.TextBox1.Value
                .Font.Name = "Arial"
                .Font.Size = 14
                .Borders.LineStyle = xlContinuous
            End With
            With .Range("X" & MaRech.Row)
                .Value = CDate(DTPicker2.Value)
                .Font.Name = "Arial"
                .Font.Size = 12
                .Borders.LineStyle = xlContinuous
            End With
            Set MaRech = Nothing
        End If
    End With
    Me.TextBox1.Value = ""
    [W3] = DTPicker1.Value
 
Application.ScreenUpdating = True
End If
End Sub

et passer a la ligne suivante jusqu'a la derniere ligne
cris

personne a une petite idee, pour avance dans mon code svp
cris

[Daniel.C]

Bonjour,

Ajoute ces lignes à la fin de la macro (avant le "End With") :

Code :

1
2
3
4
5
6
7
8
9
10
            Select Case .Range("W" & MaRech.Row) - .Range("X" & MaRech.Row)
                Case 7
                    .Range("U" & MaRech.Row).Interior.Color = 65535
                Case 14
                    .Range("U" & MaRech.Row).Interior.Color = 10092390
                Case 21
                    .Range("U" & MaRech.Row).Interior.Color = 16777062
                Case 28
                    .Range("U" & MaRech.Row).Interior.Color = 12497879
            End Select