Mise en surbrillance cellule sélectionnée

Résolu

Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention -
Patrice33740 Messages postés 8400 Date d'inscription Statut Membre Dernière intervention - 25 août 2015 à 16:52

Bonjour.

J'ai trouvé ce petit code qui met en surbrillance la cellule sélectionnée, la cellule active.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
' Highlight the active cell
Target.Interior.ColorIndex = 8
Application.ScreenUpdating = True
End Sub

Fonctionne très bien. MAIS:

Je voudrais exclure les lignes 1 et 2, qui sont colorées et qui servent d'entête.

De plus, depuis cette macro, j'ai une ligne colorée sur 2, et je ne trouve pas comment supprimer cela (même dans la mise en forme conditionnelle)

Merci

Windows 8.1 Office 2013

Afficher la suite

6 réponses

cs_Le Pivert Messages postés 8437 Statut Contributeur 730

Bonjour,

voir ceci:

https://forum.excel-pratique.com/viewtopic.php?forum_uri=cours-astuces&t=1314&start=

ce qui donne:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range(Rows(1), Rows(2))) Is Nothing Then
Application.ScreenUpdating = False
 ' Clear the color of all the cells
 Cells.Interior.ColorIndex = 0
 ' Highlight the active cell
 Target.Interior.ColorIndex = 8
 Application.ScreenUpdating = True
 End If
End Sub

Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention 7

Merci cs_Le Pivert.

J'ai essayé plusieurs combinaisons, mais sans résultats.
Comment interdire au code VBA de mise en surbrillance de s'appliquer sur la plage A1:G2 ou l'autoriser sur la plage A3:G6000 ?
0

cs_Le Pivert Messages postés 8437 Statut Contributeur 730

comme ceci:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("A3:G6000")) Is Nothing Then
Else
If Application.Intersect(Target, Range("A1:G2")) Is Nothing Then
Application.ScreenUpdating = False
 ' Clear the color of all the cells
 Cells.Interior.ColorIndex = 0
 ' Highlight the active cell
 Target.Interior.ColorIndex = 8
 Application.ScreenUpdating = True
 End If
 End If
End Sub

Patrice33740 Messages postés 8400 Date d'inscription Statut Membre Dernière intervention 1 784

bonjour,

« Je voudrais exclure les lignes 1 et 2 » Essaies :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
With Rows("3:" & Rows.Count)
  .Interior.ColorIndex = 0
  On Error Resume Next
  Intersect(Target, .Cells).Interior.ColorIndex = 8
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

« De plus, depuis cette macro, ... » ??? que veux-tu dire par là ???

Réponse 3 / 6
Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention 7

Merci cs_Le Pivert.

Fonctionne bien. Sauf que la couleur de fond de ma ligne 1 est toujours effacée. Je me retrouve donc avec un fond blanc. Comme si les lignes:

If Application.Intersect(Target, Range("A1:G2")) Is Nothing Then
Application.ScreenUpdating = False

N'étaient pas respectées.
La ligne A2:G2 garde bien sa couleur...

Pourquoi ?
Windows 8.1 Office 2013
0
1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
  
  C'est normal, cette ligne de code remet toutes les cellules en blanc:
  
  Cells.Interior.ColorIndex = 0
  
  mettre ce code pour garder la couleur de la plage A1:G2:
  
  Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Application.Intersect(Target, Range("A3:G6000")) Is Nothing Then Else If Application.Intersect(Target, Range("A1:G2")) Is Nothing Then Application.ScreenUpdating = False ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 ' Highlight the active cell Target.Interior.ColorIndex = 8 Application.ScreenUpdating = True End If End If couleurorigine End Sub Sub couleurorigine() Range("A1:G2").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5296274 'adapter la couleur .TintAndShade = 0 .PatternTintAndShade = 0 End With End Sub
  
  0
2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
  
  Et pour simplifier ce code:
  
  Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Application.Intersect(Target, Range("A3:G6000")) Is Nothing Then Else If Application.Intersect(Target, Range("A1:G2")) Is Nothing Then Application.ScreenUpdating = False ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 ' Highlight the active cell Target.Interior.ColorIndex = 8 Range("A1:G2").Interior.Color = 5296274 'adapter la couleur Application.ScreenUpdating = True End If End If End Sub
  
  Voilà, c'est simple!
  
  @+ Le Pivert
  
  0
  1. Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention 7 > cs_Le Pivert Messages postés 8437 Statut Contributeur
    
    Merci cs_Le Pivert .
    
    J'avais, bien sur, modifier cette ligne en conséquence:
    If Application.Intersect(Target, Range("A1:G2")) Is Nothing Then
    
    Mais la ligne 1 perdait quand même sa couleur, pas la 2.
    
    Sur votre premier code, le groupe de cellules A1:G2 reste encadré, sélectionné, même si on clic sur une autre cellule de la feuille.
    Sub couleurorigine()
    Range("A1:G2").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 5296274 'adapter la couleur
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With
    End Sub
    
    Le second code fonctionne très bien:
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.Intersect(Target, Range("A3:G6000")) Is Nothing Then
    Else
    If Application.Intersect(Target, Range("A1:G2")) Is Nothing Then
    Application.ScreenUpdating = False
    ' Clear the color of all the cells
    Cells.Interior.ColorIndex = 0
    ' Highlight the active cell
    Target.Interior.ColorIndex = 8
    Range("A1:G2").Interior.Color = 5296274 'adapter la couleur
    Application.ScreenUpdating = True
    End If
    End If
    End Sub
    
    0
Réponse 4 / 6
Patrice33740 Messages postés 8400 Date d'inscription Statut Membre Dernière intervention 1 784
Re,

Essaies ce code :
```
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
With Range("A3:G6000")
  .Interior.ColorIndex = 0
  On Error Resume Next
  Intersect(Target, .Cells).Interior.ColorIndex = 8
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub
```
0
1. Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention 7
  
  Bonjour Patrice. J'ai ré-ouvert le sujet.
  
  Voici le code final, qui fonctionne à merveille:
  
  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Application.Intersect(Target, Range("A1:A3000")) Is Nothing Then 'Plage'
  Application.ScreenUpdating = False
  ' Clear the color of all the cells 'Code Microsoft...'
  Cells.Interior.ColorIndex = 0
  ' Highlight the active cell
  Target.Interior.ColorIndex = 8
  Range("A1:J1").Interior.Color = 65535 'Met la plage donnée à la couleur de: adapter la couleur: '
  Application.ScreenUpdating = True
  End If
  End Sub
  
  Par contre, il m'empêche de mettre des cadres, ou parties de cadre sur mes cellules.
  (Chose possible en dehors de la plage visée), D'ou ma déduction que c'est le code qui est fautif).
  Comment modifier ce problème ?
  Merci
  
  0
  1. Patrice33740 Messages postés 8400 Date d'inscription Statut Membre Dernière intervention 1 784 > Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention
    
    Bonjour,
    
    Ce code ne répond pas du tout au besoin que tu avais exprimé ! ie : Je voudrais exclure les lignes 1 et 2, qui sont colorées et qui servent d'entête. [...] Comment interdire au code VBA de mise en surbrillance de s'appliquer sur la plage A1:G2 ou l'autoriser sur la plage A3:G6000 ? Là, tu interdit la mise en surbrillance de A1:A3000 et tu effaces la couleur de A1:G2 (pour la remettre en A1:J1 uniquement !).
    
    Enfin, si ça te convient, saches que ce code n'empêche, ni de définir une bordure de cellule(s), ni de déposer un cadre sur la feuille à quelque endroit que ce soit !
    
    Mais qu'appelles-tu un cadre ou une partie de cadre ???
    
    Patrice
    
    0
  2. Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention 7 > Patrice33740 Messages postés 8400 Date d'inscription Statut Membre Dernière intervention
    
    Merci Patrice.
    J'aurai dû dire "Bordure".
    J'ai tout modifié, tout est revenu dans l'ordre.
    Je devrais peut être réinstaller Excel. J'ai eu plusieurs bugs ces derniers jours.
    
    0
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Réponse 5 / 6
Boisgontierjacques Messages postés 177 Statut Membre 64

Bonjour,

http://boisgontierjacques.free.fr/fichiers/jb-Curseur.xls

JB
0
1. Viking58 Messages postés 186 Date d'inscription Statut Membre Dernière intervention 7
  
  Merci Boisgontierjacques.
  Ce code fonctionne bien.
  Mais mon but était de mettre en surbrillance la cellule active, tout en respectant la couleur de mon entête, soit A1:G2. La modif donnée par Patrice33740 répond à mes attentes.
  D'ou la mise du sujet en "Résolu"
  Je le garde quand même et le mets de coté.
  
  0
Réponse 6 / 6
Patrice33740 Messages postés 8400 Date d'inscription Statut Membre Dernière intervention 1 784

Re,

J'ai tout modifié, tout est revenu dans l'ordre.
Je devrais peut être réinstaller Excel. J'ai eu plusieurs bugs ces derniers jours.
Les erreurs de code VBA peuvent mettre Excel dans une situation instable, en général il suffit de redémarrer l'ordinateur pour que tout rentre dans l'ordre (à condition de ne plus reproduire la même erreur).

La réinstallation ne s'impose qu'en cas de crash du programme, mais rarement lorsqu'il détecte une erreur, en général s'il la détecte c'est qu'il fonctionne bien !
0

Mise en surbrillance cellule sélectionnée

6 réponses

Discussions similaires

Newsletters