XL 2013 Ne peut-on donc pas forcer les couleurs d'un tableau?

[jeanba]

Bonjour,

Mon code ci-après ne semble fonctionner que s'il s'applique à une plage nommée.
Dès que je veux l'appliquer à un tableau de données, les couleurs restent celles des lignes définies par les modèles Excel!! Ne peut-on donc pas forcer un tableau à avoir des couleurs de lignes qu'on veut définir et par pas de ligne que l'on souhaite, plutôt qu'une couleur différente APRES CHAQUE LIGNE?

Voici mon code (voir aussi fichier exemple joint)

Merci par avance pour votre aide!

(PS: plus de vos news Pierre Jean et Dranreb, j'espère que tout va bien...!)

Private Sub Worksheet_Change(ByVal Target As Range)
'  Dim sht$
'  sht$ = ActiveSheet.Name
  Application.ScreenUpdating = False
  couleur = 2
'     If ActiveSheet.Name <> "ACCUEIL" Then
        If Not Intersect(Target, Range(Cells(2, 2), Cells(8, 7))) Is Nothing Then
            For I = 2 To [A65000].End(xlUp).Row
                If Cells(I, 2) <> Cells(I - 1, 2) Then couleur = IIf(couleur = 2, 15, 2)
                Cells(I, 2).Resize(, 7).Interior.ColorIndex = couleur
                Cells(2, 2).Select
            Next I
        End If
'    End If

End Sub

 

[jeanba]

Je suis persuadé que quelqu'un se penchera sur ma problématique.
Je vous en remercie par avance..

 

[ChTi160]

Bonjour jeanba
je pense que ton problème (sans avoir encore testé)
vient du Fait que tu recherches la dernière ligne non vide en Colonne 1(A) et que tu travailles sur les Colonnes "B:G" !
je regarde de plus près
jean marie

 

[ChTi160]

Re
essais ceux ci

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
couleur = 2
With ActiveSheet
           derlgn = .Cells(.Rows.Count, 2).End(xlUp).Row
        If Not Intersect(Target, .Range(.Cells(2, 2), .Cells(derlgn, 7))) Is Nothing Then
            For I = 2 To derlgn
                If .Cells(I, 2) <> .Cells(I - 1, 2) Then couleur = IIf(couleur = 2, 15, 2)
                   .Cells(I, 2).Resize(, 7).Interior.ColorIndex = couleur
            Next I
        End If
End With
End Sub

il faudrait peut être trier le Tableau avant ?
jean marie

 

[jeanba]

derlgn = .Cells(.Rows.Count, 2).End(xlUp).Row

Bonsoir Jean Marie,

Ton code marche super bien dans mon fichier exemple, merci.
Cependant, ton paramètre que j'ai reproduit ci-dessus pose problème dans le fichier réel, car mon tableau du fichier réel est un Range (Cells(9, 2), Cells(232, 16)). Et à chaque changement dans une des cellules de la plage "H9:I232", la macro doit s'exécuter..
Et donc, en essayant d'adapter ton code, je suis pas très à l'aise encore avec "End(xlUp ou Down)...

 

[jeanba]

Application.ScreenUpdating = False
couleur = 2
With ActiveSheet
     '      derlgn = .Cells(.Rows.Count, 2).End(xlUp).Row
'       If Not Intersect(Target, .Range(.Cells(9, 2), .Cells(232, 16))) Is Nothing Then
            For I = 9 To 232
                If .Cells(I, 2) <> .Cells(I - 1, 2) Then couleur = IIf(couleur = 2, 15, 2)
                   .Cells(I, 2).Resize(, 16).Interior.ColorIndex = couleur
            Next I
  '      End If
End With

Ce code adapté génère le message d'erreur:

 

[jeanba]

' If Not Intersect(Target, .Range(.Cells(9, 2), .Cells(232, 16))) Is Nothing Then

Cette ligne est testée directement dans la Private Sub qui appelle la fonction..

 

[ChTi160]

Re
cette ligne

If Not Intersect(Target, .Range(.Cells(9, 2), .Cells(232, 16))) Is Nothing Then

permet de limiter l'action de changement dans la Plage ainsi définie.
je ne comprends donc pas ?
jean marie

 

[jeanba]

Oui, c'est ce que j'ai mis dans le Private Sub
Normalement, le code est bon, sauf qu'il m'est donné ce message d'erreur

Je sais pas d'où vient ce blocage...pourtant, sur la feuille exemple, ça allait bien

 

[Si...]

Salut

Chti, c'est la boucle qui pose problème (avec ce que j'ai compris)

jeanba, le tableau présent Tb étant déjà avec des lignes à bandes, ne pas confondre les 2 gris.
[Code vb]

Private Sub Worksheet_Change(ByVal R As Range)
  If Intersect(R, [Tb[C2]]) Is Nothing Or R.Rows.CountLarge > 1 Then Exit Sub 'hors colonne 2 du tableau titrée C2
  If R <> R(0, 1) Then R(1, 0).Resize(, 16).Interior.ColorIndex = IIf(R.Interior.ColorIndex = 15, xlNone, 15)
  [B2].Select
End Sub

Voir l'autre discussion ci- après pour comprendre l'utilisation des tableaux (que tu définis à chaque fois)

 

[ChTi160]

Bonsoir Si...
Merci!
Je n y comprends plus rien lol
Entre la definition de la plage
Voir H2:I232
Recherche dans la colonne 2 etc etc
Je regarde cela demain.
Jean marie