Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

jeanba

XLDnaute Occasionnel
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...!)

VB: 
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
 

Pièces jointes

  • Forcer couleurs de lignes d'un tablo.xlsm
    15.7 KB · Affichages: 29
Trier par date Trier par votes

ChTi160

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Re
essais ceux ci
VB: 
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
 
Vote positif 0 Vote négatif

jeanba

XLDnaute Occasionnel
ChTi160 à dit:
derlgn = .Cells(.Rows.Count, 2).End(xlUp).Row
Cliquez pour agrandir...

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)...
 
Vote positif 0 Vote négatif

jeanba

XLDnaute Occasionnel
VB: 
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:
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Re
cette ligne
VB: 
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
 
Vote positif 0 Vote négatif

jeanba

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
S

Si...

XLDnaute Barbatruc
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]
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)
 

Pièces jointes

  • couleurs de lignes d'un tablo.xlsm
    23 KB · Affichages: 21
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

B
  • Question
Microsoft 365 [RESOLU] Supprimer Ligne rapidement et avec plusieurs conditions
Réponses
5
Affichages
135
BENAM69
B
M
  • Question
XL 2013 Bouton commande ne fonctionne pas
Réponses
7
Affichages
224
midovic
M
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
124
Phil69970
F
  • Question
XL 2019 l'indice n'appartient pas à la sélection
Réponses
9
Affichages
554
job75
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
194
aziz
A
D
  • Question
Microsoft 365 Application.WorksheetFunction.VLookup ne fonctionne pas au delà de 8500 lignes
Réponses
4
Affichages
312
DimiJuju
D
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
324
TooFatBoy
  • Résolu(e)
XL 2019 Ne pas utiliser les MFC
Réponses
5
Affichages
360
Usine à gaz
M
  • Résolu(e)
Microsoft 365 Erreur code ou pas ?
2
Réponses
17
Affichages
356
Marvin57
M
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
404
Messan
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…