× Aidez la recherche contre le COVID-19 avec votre ordi ! Rejoignez l'équipe PC Astuces Folding@home
 > Tous les forums > Forum Bureautique
 Mettre une ligne en couleurSujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
gpl85
  Posté le 26/09/2019 @ 15:59 
Aller en bas de la page 
Nouvel astucien

Bonjour aux astuciens,



J'ai trouvé dans le forum une astuce pour mettre la ligne active en couleur, sans perdre ses couleurs d'origine. Voici l'astuce :

Private Sub Worksheet_Deactivate()
ResetRow
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
iR = Target.Row
On Error Resume Next
If iLastR > 0 Then
For i = 1 To 256
Cells(iLastR, i).Interior.ColorIndex = Tablo(i)
Next
End If
For i = 1 To 256
Tablo(i) = Cells(Target.Row, i).Interior.ColorIndex
Next
Rows(iR).Interior.ColorIndex = 38
iLastR = iR
End Sub

Lorsque je l'utilise, il y a un blocage sur le mot "Tablo".

Merci de m'indiquer la correction à faire.

Cordialement,

Gpl85

[Configuration automatique à compléter]
Windows 10
Chrome 77.0.3865.90

Publicité
Debrief
 Posté le 27/09/2019 à 13:01 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Bonjour,

Il y a plusieurs petits problèmes dans ce code.

1 - Il n'y a pas l'option Option Explicit en tête du code donc pas d'obligation de déclarer les variables ce qui n'est pas dans la nature d'un code sous contrôle.

2 - Tablo() est un tableau et lui n'échappe pas à une déclaration indiquant au moins que c'est un tableau(), c'est pour ça que ça plante.

3 - Tablo() et iLastR doivent conserver leurs valeurs d'un appel à un autre, et pour ça 2 solutions:
- déclarer ces variables statiques à l'intérieur de la procédure, mais leur visibilité restera pour la procédure uniquement
- déclarer ces variables au niveau du module pour qu'elles soient visibles de toutes les procédures du module
C'est la 2ème solution qu'il faut adopter car 2 procédures (Worksheet_SelectionChange et Worksheet_Deactivate) y font référence

4 - Ce système fonctionne sur la base d'une mémorisation du ColorIndex des 256 cellules en colonne de la ligne sélectionnée avant colorisation en rose (ColorIndex = 38)
Y en a pas bon du tout car:
- Le nombre de colonnes est 256 (colonne IV) pour Excel 97-2003 mais 16384 (colonne XFD) pour Excel au-delà.
- ColorIndex n'est pas représentatif de la couleur de fond, c'est Color qu'il faudrait stocker.

Cette méthode qui consiste à stocker la couleur des cellules à la sélection avant coloriage de la ligne puis la restituer sur une autre sélection n'est pas très bonne:
- à chaque sélection il faut faire une boucle de 16384 affectations pour stoker et 16384 affectations pour déstocker. Et ça prend de la CPU et rend la manip assez lente.
- S'il y a de MFC sur les cellules qui colorient ces cellules, les MFC seront toujours prioritaire et le coloriage sera sans effet.

Voici quand même ce code corrigé:

Option Explicit

Dim Tablo() As Long
Dim iLastR As Long
Dim NbColonnes As Integer

Private Sub Worksheet_Deactivate()
ResetRow
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iR As Long
Dim i As Integer
Dim VersionExcel As Integer

If NbColonnes = 0 Then
VersionExcel = Replace(Application.Version, ".", Application.DecimalSeparator)
If VersionExcel < 12 Then NbColonnes = 256 Else NbColonnes = 16384
ReDim Tablo(1 To NbColonnes)
End If

iR = Target.Row

Call ResetRow

For i = 1 To NbColonnes
Tablo(i) = Cells(Target.Row, i).Interior.Color
Next

Rows(iR).Interior.ColorIndex = 38
iLastR = iR
End Sub

Private Sub ResetRow()
Dim i As Integer

If iLastR > 0 Then
For i = 1 To NbColonnes
Cells(iLastR, i).Interior.Color = Tablo(i)
Next
End If
End Sub

Cordialement,
D.

Debrief
 Posté le 27/09/2019 à 13:41 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Si tu veux une méthode efficace de colorisation de la ligne sélectionnée, tu peux essayer ce code initialement copié de notre regretté Ferrand, et récemment amélioré pour:
- Générer automatiquement le Nom dans le gestionnaire de nom et la MFC nécessaire,
- Traiter la différenciation de la sélection selon qu'elle est faite par un clic souris ou par un déplacement curseur,
- Ajouter quelques paramètres optionnels dont les valeurs par défaut sont dans des constantes modifiables.

'Constantes modifiables valeurs par défaut des paramètres optionnels du Sub SurligneLigne()
Const NbLignesTitre = 1 'Nombre de lignes titre de la feuille à ne pas surligner
Const SélectionTouches = True 'Accepter ou non la sélection de cellule par les touches clavier
Const SélectionClick = True 'Accepter ou non la sélection de cellule par le clic souris
Const SélectionGarder = False 'Garder ou non la sélection en cours si la nouvelle sélection n'est pas valide
Const ColorSurlignage = 13434879 'Code couleur .Color de surlignage

Il te suffit d'extraire de ce classeur https://www.cjoint.com/c/IIBmGUpZEfN le module Module_SurligneLigne et d'appeler le sub SurligneLigne(Target) dans le Sub Worksheet_SelectionChange de la feuille.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call SurligneLigne(Target)
End Sub

D.



Modifié par Debrief le 27/09/2019 14:32
Debrief
 Posté le 27/09/2019 à 14:47 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Je t'ai dit un bêtise concernant ton code actuel...
Il faut mémoriser .Color ET .ColorIndex car .ColorIndex peut aussi prendre les valeurs xlColorIndexAutomatic ou xlColorIndexNone qui ont un rôle important.

Donc ça rend encore plus long le traitement nécessaire au Save et Restore des couleurs des cellules de la ligne sur ue fichier Excel > 2003 !

Option Explicit

Dim Tablo() As Long
Dim iLastR As Long
Dim NbColonnes As Integer

Private Sub Worksheet_Deactivate()
ResetRow
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iR As Long
Dim i As Integer
Dim VersionExcel As Integer

If NbColonnes = 0 Then
VersionExcel = Replace(Application.Version, ".", Application.DecimalSeparator)
If VersionExcel < 12 Then NbColonnes = 256 Else NbColonnes = 16384
ReDim Tablo(1 To NbColonnes, 1 To 2)
End If

iR = Target.Row

Call ResetRow

For i = 1 To NbColonnes
Tablo(i, 1) = Cells(Target.Row, i).Interior.Color
Tablo(i, 2) = Cells(Target.Row, i).Interior.ColorIndex
Next

Rows(iR).Interior.ColorIndex = 38
iLastR = iR
End Sub

Private Sub ResetRow()
Dim i As Integer

If iLastR > 0 Then
For i = 1 To NbColonnes
Cells(iLastR, i).Interior.Color = Tablo(i, 1)
Cells(iLastR, i).Interior.ColorIndex = Tablo(i, 2)
Next
End If
End Sub

gpl85
 Posté le 29/09/2019 à 09:46 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Nouvel astucien
Debrief a écrit :

Je t'ai dit un bêtise concernant ton code actuel...
Il faut mémoriser .Color ET .ColorIndex car .ColorIndex peut aussi prendre les valeurs xlColorIndexAutomatic ou xlColorIndexNone qui ont un rôle important.

Donc ça rend encore plus long le traitement nécessaire au Save et Restore des couleurs des cellules de la ligne sur ue fichier Excel > 2003 !

Option Explicit

Dim Tablo() As Long
Dim iLastR As Long
Dim NbColonnes As Integer

Private Sub Worksheet_Deactivate()
ResetRow
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iR As Long
Dim i As Integer
Dim VersionExcel As Integer

If NbColonnes = 0 Then
VersionExcel = Replace(Application.Version, ".", Application.DecimalSeparator)
If VersionExcel < 12 Then NbColonnes = 256 Else NbColonnes = 16384
ReDim Tablo(1 To NbColonnes, 1 To 2)
End If

iR = Target.Row

Call ResetRow

For i = 1 To NbColonnes
Tablo(i, 1) = Cells(Target.Row, i).Interior.Color
Tablo(i, 2) = Cells(Target.Row, i).Interior.ColorIndex
Next

Rows(iR).Interior.ColorIndex = 38
iLastR = iR
End Sub

Private Sub ResetRow()
Dim i As Integer

If iLastR > 0 Then
For i = 1 To NbColonnes
Cells(iLastR, i).Interior.Color = Tablo(i, 1)
Cells(iLastR, i).Interior.ColorIndex = Tablo(i, 2)
Next
End If
End Sub

Debrief, bonjour,

Merci pour ton nouveau message. La lenteur d'exécution n'est pas un obstacle, ce qui est important c'est de colore en gardant la mise en forme.

Cordialement,

GPL85

Gorfous
 Posté le 29/09/2019 à 12:56 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salutations

Dim Dligne As Long
Dim MaPlage As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage As Range
Application.ScreenUpdating = False
If Target.Cells.Column > 1 Then Exit Sub
EffCouleur
Set Plage = Application.Intersect(MaPlage, Rows(Target.Row))
If Not Plage Is Nothing Then
Plage.Interior.ColorIndex = 36
End If
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Activate()
Application.ScreenUpdating = True
EffCouleur
Application.ScreenUpdating = False
End Sub

Sub EffCouleur()
Dim Ligne As Long
Dligne = Range("A" & Rows.Count).End(xlUp).Row
Set MaPlage = Range("A2:AA" & Dligne)
MaPlage.Interior.ColorIndex = xlNone
For Ligne = 1 To Dligne Step 2
MaPlage.Rows(Ligne).Interior.ColorIndex = 35
Next Ligne
End Sub

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Les bons plans du moment PC Astuces

Tous les Bons Plans
20,99 €Micro clé USB 3.1 Sandisk Ultra Fit 128 Go à 20,99 €
Valable jusqu'au 10 Juillet

Amazon fait une promotion sur la micro clé USB Sandisk Ultra Fit d'une capacité de 128 Go qui passe à 20,99 €. La minuscule taille de cette clé USB va vous permettre de la laisser brancher en permanence sur votre portable, votre TV ou votre autoradio sans qu'elle dépasse de manière disgracieuse. Sa compatibilité USB 3.1 lui permet d'atteindre des débits jusqu'à 130 Mo/s. 


> Voir l'offre
548,15 €Disque dur externe Western Digital My Book Duo 24 To USB 3.1 à 548,15 € livré
Valable jusqu'au 07 Juillet

Amazon Allemagne propose actuellement le disque dur externe Western Digital My Book 24 To USB 3.1 à 538,96 € (avec la TVA ajustée). Comptez 9,19 € pour la livraison en France soit un total de 548,15 € livré. On le trouve ailleurs à partir de 800 €. Le My Book Duo est une solution de stockage RAID de bureau d’une très grande capacité, idéale pour stocker des photos, des vidéos, des documents et de la musique. Vous pourrez l'utiliser en mode RAID 0 pour des perfomances ultrarapides (vitesse de lecture séquentielle pouvant atteindre 360 Mo/s) ou bien en mode RAID 1 pour bénéficier d’une redondance et mettre vos données en miroir sur les disques durs installés dans le boîtier. Ce dernier comporte en effet 2 disques durs Western Digital RED de 12 To adaptés aux NAS et qui peuvent être récupérés pour être utilisés ailleurs. Sachant qu'un disque dur RED 12 To coûte au moins 450 €, l'achat du Western Digital My Book Duo 24 To peut aussi être une solution économique si vous avez besoin de 2 disques durs 12 To pour votre NAS.

Vous pouvez utiliser votre compte Amazon France sur Amazon Allemagne et il n'y a pas de douanes. Si vous êtes perdu en allemand, vous pouvez traduire le site en anglais.


> Voir l'offre
Jusqu'à -45% sur Moulinex : Cookeo, Masterchef, Companion, Blender, ...
Valable jusqu'au 12 Juillet

Moulinex est à l'honneur cette semaine sur Amazon avec des offres jusqu'à -45% sur les Cookeo, Robots Companion, Masterchef, Blender, ...


> Voir l'offre

Sujets relatifs
Aucun sujet pertinent lié trouvé
 > Tous les forums > Forum Bureautique