Discussion :

[chochois]

Bonjour,
question bete sans doute
je voudrais modifier temporairement une portion continue de ligne au passage de la sourie sur une cellule de cette portion de ligne.
Facile non ?
Merci d avance
Jean-Gilles

[fring]

Bonjour,

Ce n'est pas compliqué à réaliser mais il faut un peu bricoler pour pouvoir capter un déplacement de souris au dessus d'une cellule

Tu insères 2 LABEL sur la feuille (Label1 et Label2)
Pour chaque Label, tu modifies leurs propriétés Caption et BackStyle
Caption = rien
BackStyle = fmBackStyleTransparent

Supposons qu'on veut détecter un déplacement au-dessus de la cellule B5
On va dimensionner le Label1 légèrement plus grand que la cellule et le centrer par rapport à celle-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub Dim_Label1()
With ActiveSheet.Shapes("Label1")
    .Width = [B5].Width + 10
    .Height = [B5].Height + 10
    .Left = [B5].Left - 5
    .Top = [B5].Top - 5
End With
End Sub

On dimensionne et positionne le Label2 selon les dimensions et position de la cellule B5

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub Dim_Label2()
With ActiveSheet.Shapes("Label2")
    .Width = [B5].Width
    .Height = [B5].Height
    .Left = [B5].Left
    .Top = [B5].Top
End With
End Sub

Reste à programmer les procédures événementielles "MouseMove" des LABEL

Par exemple pour colorer les cellules E5 et F5 en jaune lorsqu'on survole la cellule B5, ce qui correspond au survol du Label2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Range("E5:F5").Interior.ColorIndex = 6
End Sub

Et pour revenir à la couleur initiale lorsqu'on quitte la cellule B5, ce qui correspond au survol du Label1, légèrement plus grand que le Label2 et positionné sous le Label2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Range("E5:F5").Interior.ColorIndex = xlNone
End Sub