Survole de cellule sue Excel

Le 20/09/2023 à 17:15

Bonjour à vous

J'ai repris un fichier existant sur le site que je voudrais finir de transformer, cela concerne le survole de cellule.

La ligne 2 devient rouge quand le met le curseur en B2 (voir mon fichier)

19survole-de-cellule.zip (24.17 Ko)

Je voudrais la même effet pour chaque ligne.
J'ai fait quelque transformation sur le ficher d'origine, mais je suis bloqué.
Je joins mon fichier
Merci d'avance BD

Le 20/09/2023 à 21:41

Bonsoir,

avec ce système il vous faut un label par ligne ! Ou alors un seul label et en fonction de la position de la souris sur ce label on peut déterminer quelle ligne il faut mettre en couleur.

Mais un clic gauche sur une cellule ne vous convient pas ?

@ bientôt

LouReeD

Le 21/09/2023 à 04:41

Bonsoir,

Voilà 2 solutions (Code à mettre dans la feuille voulue) - commentaires dans le code

Surlignage par sélection :

Public AdrRow As String
Public S_Count As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Auteur RyuAutodidacte
Dim S As String, DebutLigne As Integer, Derligne As Long

    S = "B:H" 'Colonnes voulues pour le surlignage
    DebutLigne = 2   ' à partir de quelle ligne on prend en compte le surlignage
    Derligne = Cells(Rows.Count, "B").End(xlUp).Row    ' à partir de quelle ligne on ne prend plus en compte le surlignage

    ' Empêche le surlignage si la selection est en dehors de la zone => ici B:H de la ligne 2 à la dernière ligne non vide
    If Not Application.Intersect(Target, Range(S).Rows(DebutLigne & ":" & Derligne)) Is Nothing Then

        'on supprime l'ancien surlignage
        If AdrRow <> "" Then Range(S).Rows(Range(AdrRow).Row).Resize(S_Count).Interior.ColorIndex = xlNone

        If [A1] = "True" Then 'Choisir un Cellule pour activer le surlignage en marquant True - ici en A1
            Range(S).Rows(Target.Row).Resize(Selection.Rows.Count).Interior.ColorIndex = 6  ' Surlignage dela zone sélectionnée
        End If

        ' variable public pour effacerl'ancien surlignage
        S_Count = Selection.Rows.Count
        AdrRow = Selection.Address
    End If
End Sub
' PS ; possiblité de surligné plusieurs lignes contigues

Surlignage par clic droit sur la cellule :

Public AdrRow As String

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'Auteur RyuAutodidacte
Dim S As String, DebutLigne As Integer, Derligne As Long

    S = "B:H" ' Colonnes voulues pour le surlignage
    DebutLigne = 2   ' à partir de quelle ligne on prend en compte le surlignage
    Derligne = Cells(Rows.Count, "B").End(xlUp).Row    ' à partir de quelle ligne on ne prend plus en compte le surlignage

    ' Empêche le surlignage si la selection est en dehors de la zone => ici B:H de la ligne 2 à la dernière ligne non vide
    If Not Application.Intersect(Target, Range(S).Rows(DebutLigne & ":" & Derligne)) Is Nothing Then

        'on supprime l'ancien surlignage
        If AdrRow <> "" Then Range(S).Rows(Range(AdrRow).Row).Interior.ColorIndex = xlNone

        If [A1] = "True" Then 'Choisir un Cellule pour activer/désavtiver le surlignage - marquer True pour activer - ici en A1
            Range(S).Rows(Target.Row).Interior.ColorIndex = 6 'Surlignage dela zone sélectionnée
        End If

        ' variable public pour effacerl'ancien surlignage
        AdrRow = Selection.Address
        Cancel = True 'on annule le clic droit
    End If
End Sub
Le 21/09/2023 à 11:18

Bonjour à vous et merci de m'avoir répondu, j'y connaît pratiquement rien en VBA .

CE QUE JE SOUHAITE:

- quand je suis sur une cellule, a1 par exemple la ligne a1: h1 par exemple change de couleur.

idem pour plusieurs cellule a1 a2 a3 etc.

Pouvez-vous me renvoyer le fichier ce sera plus simple pour moi.

Merci beaucoup

Le 21/09/2023 à 15:32

Bonjour,

• Dans la 1ère Feuille : via macro avec sélection :

image

- la flèche rouge indique ou se trouve la Macro
- l'encadré rouge montre les paramètres que vous pouvez modifier

highlight

• Dans la second feuille, le surlignement se fait avec une Mise En Forme Conditionnelle - Sélectionner une Cellule et actualiser avec F9

la Formule est :

=CELLULE("ligne")=LIGNE()
13exemple-highlight.xlsm (19.29 Ko)
Le 21/09/2023 à 19:03

Bonsoir,
RyuAutodidacte bonsoir,

une proposition avec le survole d'un Label ActiveX sur la colonne A qui "allume" les colonnes B à H :

28couleur-survole-cellule.xlsm (21.38 Ko)

Si votre tableau comporte des couleurs qu'il faut conserver alors il faudra passer par une MFC en fonction d'une valeur inscrite en colonne A, cette valeur dépendant de la position de la souris sur le Label, comme cela vos couleurs resteront intactes.

@ bientôt

LouReeD

Le 21/09/2023 à 20:01

Avec conservation des couleurs sur le tableau :

13couleur-survole-cellule-garde-les-couleurs.xlsm (21.56 Ko)

@ bientôt

LouReeD

Le 22/09/2023 à 03:24

Bonsoir,

Hello @LouReeD,

Désolé mais je suis sur Mac donc tout ce qui est activeX ne marche pas sur Mac

activex

Je privilégie quasi tout le temps les codes vba qui marchent sur Mac et PC …

Voilà donc une autre solution qui n'efface pas les couleurs (3ème feuille - MACRO ET MFC)

- une qui sélectionne seulement une ligne :

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'auteur Ryuautodidacte
Dim Col As String, Deb As Byte, DerL As Long
    Col = "A:H":       Deb = 1:       DerL = Cells(Rows.Count, Mid(Col, 1, 1)).End(xlUp).Row

    If Not Application.Intersect(Target, Range(Col).Rows(Deb & ":" & DerL)) Is Nothing Then
        Range(Col).Rows(Deb & ":" & DerL).FormatConditions.Delete
        With Range(Col).Rows(Target.Row)
            .FormatConditions.Add Type:=2, Formula1:="=CELLULE(""ligne"")=LIGNE()"
            With .FormatConditions(1)
                .Interior.ColorIndex = 6
                .StopIfTrue = False
            End With
        End With
    End If

End Sub

- une qui sélectionne seulement une ligne ou plusieurs lignes contigues :

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'auteur Ryuautodidacte
Dim Col As String, Deb As Byte, DerL As Long
    Col = "A:H":       Deb = 1:       DerL = Cells(Rows.Count, Mid(Col, 1, 1)).End(xlUp).Row

    If Not Application.Intersect(Target, Range(Col).Rows(Deb & ":" & DerL)) Is Nothing Then
        Range(Col).Rows(Deb & ":" & DerL).FormatConditions.Delete
        With Range(Col).Rows(Target.Row).Resize(Selection.Rows.Count)
            .FormatConditions.Add Type:=2, Formula1:="=LIGNES(" & Target.Address & ")"
            With .FormatConditions(1)
                .Interior.ColorIndex = 6
                .StopIfTrue = False
            End With
        End With
    End If
End Sub

Bien sur comme les colonnes, ligne de départ et ligne de fin sont paramétrables …

Le fichier :

19exemple-highlight.xlsm (26.43 Ko)
Le 22/09/2023 à 11:54

Bonjour,

Pour le Mac j'essaie d'y penser, mais quelque fois un ActiveX est "plus" simple et malheureusement ça ne marche pas sur Mac.

De plus, je suis resté sur l'idée première du demandeur.

Et vous devez avoir un 365 Mac alors ? Je dis cela pour votre profile...

Sinon comme je le demandais dans ma première réponse : "un clic gauche sur une cellule ne vous convient pas ? "

Merci à vous pour les propositions "clic gauche/droit"!

@ bientôt

LouReeD

Le 22/09/2023 à 12:31

Merci beaucoup RYUAUTODIDACTE c'est exactement ce que je voulais

Bardo

Le 22/09/2023 à 13:00

Bonjour Bardo

Merci beaucoup RYUAUTODIDACTE c'est exactement ce que je voulais

Super
Il ne te reste plus qu'à indiquer le message qui vous convient comme solution afin de clôturer ce post,
et mettre 1 point (ce n'est pas une obligation) sur les messages que vous trouvez utiles

Bonne fin de journée

Le 30/09/2023 à 19:30

Bonsoir RyuAutodidacte, je suis de retour

la version avec MCF est aussi intéressante, pour Macro et MCF je ne sait pas.

Par contre avec macro et mcf si je clic sur un lettre de colonne toute les lignes après le texte deviennent jaune et le reste.

Encore merci Bardo

Rechercher des sujets similaires à "survole sue"