Discussion :

[Patate3181]

Bonjour,

Je souhaiterai effectuer une MFC sur des cellules d'un tableur.

J'ai une cellule "Z16" dans lequel il y a un chiffre variable en l’occurrence on va dire 3.
En fonction de ce chiffre, un certains nombre de cellules se mettent en forme. je voudrai que si elles sont vides, les cellules s'affichent d'une certaine couleur et si elles sont remplies elles se remettent en blanc comme initialement. (Enfin transparent quoi)
J'ai réussis à mettre en place la première MFC mais lorsqu'il s'agit de faire l'autre partie (Celle ou ca se remet en transparent) je n'arrive pas à le faire ligne par ligne ! C'est tout le bloc qui se change

Etat actuel :



Etat souhaité :


J'ai essayé avec la fonction With et la fonction If mais je dois mal les utiliser car rien ne se passe

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim MaVariable As Range
 With Range(Cells(i + 20, 24), Cells(i + 20, 25))
 Set MaVariable = Range(Cells(i + 20, 24), Cells(i + 20, 25))
    .FormatConditions.Add Type:=xlExpression, Formula1:="=NBCAR(SUPPRESPACE(X21))=0"
   ' .FormatConditions.Add Type:=xlExpression, Formula1:="=NBCAR(SUPPRESPACE(" & MaVariable & "))=0" 'J'ai voulu tenté avec une variable mais ça fait tout planter et je n'ai plus aucun résultat
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 199, 206)
        .TintAndShade = 0
    End With
    End With

Code :

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

1
2
3
4
5
6
 
'Range(Cells(i + 20, 24), Cells(i + 20, 25)) 'Correspond à mes cellules qui s'ajoutent quand je renseigne le nombre de paramètres
  If IsEmpty(Range(Cells(i + 20, 24), Cells(i + 20, 25))) Then
    Range(Cells(i + 20, 24), Cells(i + 20, 25)).Interior.Color = RGB(255, 199, 206)
    Else
    Range(Cells(i + 20, 24), Cells(i + 20, 25)).Interior.Color = RGB(255, 255, 255)

Auriez-vous une idée de comment je peux faire en sorte de n'avoir que la cellule dans laquelle j'écrit qui se remet en transparent ?

Pour vous situer un peu le contexte, il s'agit d'une validation visuelle tant que la cellule est rougeâtre, l'utilisateur l'a oubliée.

Le code est plus gros que ça mais je sais pas si c'est réellement utile de vous le mettre en entier. Afin d'éviter un spam potentiellement inutile je le met pas dans un premier temps. Si vous en avez besoin je le mettrais lors de mon prochain post

Merci d'avance,
Cordialement,
Axel

[EricDgn]

Bonjour,

Quelque chose de ce genre devrait convenir:

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
Sub Macro1()
    Dim i As Long, r As Range, f As String
    i = 4
    Set r = Range(Cells(20, 24), Cells(20 + i, 25))
    f = "=NBCAR(SUPPRESPACE(" & Cells(20, 24).Address(False, False) & "))=0"
    With r
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=f
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.399945066682943
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Set r = Nothing
End Sub

Il faut utiliser la même cellule dans la définition du Range et de la formule, dans l'exemple donné ci-dessus: Cells(20,24).

Pour info:
Cells(20,24).Address = $X$20
Cells(20,24).Address( True, False) = X$20
Cells(20,24).Address( False, False) = X20

Cordialement.

[Patate3181]

Bonsoir !

Ca fonctionne merci beaucoup c'est exactement ce que je voulais !
Cependant j'ai deux cellules qui se colorent en bas sans aucune raison et qui ne se fusionnent pas !

Edit : J'ai du faire quelques modifications sur le fichier. l'adresse de mes cellules à donc changé donc j'ai du faire cette modification là mais je ne vois pas à quel moment je lui dis d'aller récupérer la couleur plus bas !

Voila la code que j'ai utilisé
J'ai enlevé aussi le i=4 étant donné que c'est une variable

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
  Set r = Range(Cells(95, 24), Cells(95 + i, 25))
    f = "=NBCAR(SUPPRESPACE(" & Cells(95, 24).Address(False, False) & "))=0"
    With r
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=f
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .Color = RGB(255, 199, 206)
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Set r = Nothing

Et je met aussi le code entier si cela vous intéresse pour comprendre le fonctionnement du bousin

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
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, r As Range, f As String
 
    If Target.Address = "$Z$91" And IsNumeric(Target) Then 'si la cellule modifiée est bien Z16 et si la valeur est numérique
        Application.ScreenUpdating = False 'Evite les scintillements de l'affichage et augmente la vitesse d'exécution.
        Application.EnableEvents = False 'inhibe la détection de tout changement dans la feuille, ne rend pas la main au système
        Range("X96:Y100000").Clear 'on efface les précédents résultats
        For i = 1 To Target.Value 'on boucle de 1 jusqu'à la valeur saisie en Z16
 
            Range(Cells(i + 95, 24), Cells(i + 95, 25)).MergeCells = True 'fusion des cellules
        With Range(Cells(i + 95, 24), Cells(i + 95, 25))
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
    End With
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
 
    Set r = Nothing
Next i 'boucle
        Application.EnableEvents = True 'rend la main au système afin qu'il puisse détecter toute modification sur la feuille
    Set r = Range(Cells(95, 24), Cells(95 + i, 25))
    f = "=NBCAR(SUPPRESPACE(" & Cells(95, 24).Address(False, False) & "))=0"
    With r
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=f
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .Color = RGB(255, 199, 206)
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Set r = Nothing
    End If
 
End Sub

Merci Eric,

Cordialement,
Axel

[EricDgn]

Cela devrait être ceci:

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
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, r As Range, f As String
    Debug.Print Target.Address, IsNumeric(Target)
    If Target.Address = "$Z$91" And IsNumeric(Target) Then 'si la cellule modifiée est bien Z16 et si la valeur est numérique
        Application.ScreenUpdating = False  'Evite les scintillements de l'affichage et augmente la vitesse d'exécution.
        Application.EnableEvents = False    'inhibe la détection de tout changement dans la feuille, ne rend pas la main au système
        Range("X96:Y100000").Clear          'efface les précédents résultats
        For i = 1 To Target.Value
        'boucle de 1 jusqu'à la valeur saisie en Z16
            Range(Cells(i + 95, 24), Cells(i + 95, 25)).MergeCells = True 'fusion des cellules
            With Range(Cells(i + 95, 24), Cells(i + 95, 25))
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
        Next i 'boucle
        Application.EnableEvents = True 'rend la main au système afin qu'il puisse détecter toute modification sur la feuille
        Set r = Range(Cells(96, 24), Cells(Target.Value + 95, 24))
        f = "=NBCAR(SUPPRESPACE(" & Cells(96, 24).Address(False, False) & "))=0"
        With r
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:=f
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent2
                .Color = RGB(255, 199, 206)
            End With
            .FormatConditions(1).StopIfTrue = False
        End With
        Set r = Nothing
    End If
End Sub

Cordialement

[Patate3181]

Ah oui c'est parfait !
Effectivement je n'avais pas pensé à mettre deux cellules différentes dans les Cells pour moi ca devait tout le temps être la même pour que ça fonctionne et que ça garde une cohérence !

Quoi qu'il en soit, vraiment merci beaucoup c'est résolu !

Bonne soirée !
Cordialement,
Axel