Colorisation TextBox ActiveX MouseMove

Le 21/11/2019 à 13:42

Bonjour à tous,

Je cherche à colorer le "Backcolor" d'une TextBox au passage de la souris sur celle ci, et le décolorer quand la position de la souris se trouve en dehors de la TextBox.

Je voudrais par la suite quand je clique sur une des Textbox, que la couleur de celle ci reste fixe, pendant que les autres continueront de "clignoter" en fonction du passage de la souris jusqu’à un nouveau clic sur une autre TextBox.

J'ai réussi à adapter une méthode trouver sur Developpez qui provient de patricktoulon, que je remercie au passage, mais un défaut de fluidité intervient quand le curseur se déplace trop vite entre 2 TextBox.

Est ce que quelqu'un au rait une solution à ce problème?

49classeur1.xlsm (31.50 Ko)
Le 21/11/2019 à 14:53

Salut,

Si tu remplace les "Sleep 5" par des "Sleep 1" dans ton code, cela te paraît-il mieux ?

Girodo,

Le 21/11/2019 à 14:59

Bonjour Girodo,

Merci de ta réponse, le fait de mettre sleep 1 ne rend pas plus fluide le résultat attendu et j'ai toujours le cas ou 2 Textbox peuvent être colorées en même temps.

Le 21/11/2019 à 17:38

Salut Florian,

Salut Girodo,

Questions :

  • je lis que tu as récupéré le code mais as-tu besoin des fonctions GetCursor et Sleep, franchement ?
  • pourquoi utiliser des TextBox alors que, vu le contexte, des Label seraient plus appropriées ?
Public Sub DelColor(ByVal iIdx%)
'
Dummy = DoEvents()
For X = 1 To 5
    Me.OLEObjects("TextBox" & X).Object.BackColor = IIf(X = iIdx Or Me.OLEObjects("TextBox" & X).Object.Font.Bold = False, &H1A31D5, &H3E352A)
Next
'
End Sub

Public Sub Focus(ByVal iIdx%)
'
For X = 1 To 5
    Me.OLEObjects("TextBox" & X).Object.Font.Bold = IIf(X = iIdx, False, True)
Next
'
End Sub

A te lire.

A+

42classeur1.xlsm (31.29 Ko)
Le 21/11/2019 à 17:59

Bonjour à tous,

Florian53 a écrit :

...mais un défaut de fluidité intervient quand le curseur se déplace trop vite entre 2 TextBox.

Ne sachant pas si c'est quelque chose de modifiable avec ta méthode, je suis parti d'une feuille blanche.

Je n'ai pas compris le choix de l'utilisation de TextBox, je les ai remplacés par 2 Labels par ligne (2 Labels pour mieux centrer le texte) :

menu
Florian53 a écrit :

Je voudrais par la suite quand je clique sur une des Textbox, que la couleur de celle ci reste fixe, pendant que les autres continueront de "clignoter" en fonction du passage de la souris jusqu’à un nouveau clic sur une autre TextBox.

C'est ajouté également.

Le fichier :

40menu-avec-survol.xlsm (39.35 Ko)

Le code :

'https://forum.excel-pratique.com/viewtopic.php?f=2&t=132543
Dim numeroClic

'SURVOL
Private Sub overColor(numero)
    resetColors
    ActiveSheet.OLEObjects("Label" & numero).Object.BackColor = &H1A31D5
End Sub

Private Sub resetColors()
    For i = 1 To 5
        ActiveSheet.OLEObjects("Label" & i).Object.BackColor = IIf(numeroClic = i, &H1A31D5, &H3E352A)
    Next
End Sub

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 1
End Sub
Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 2
End Sub
Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 3
End Sub
Private Sub Label4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 4
End Sub
Private Sub Label5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 5
End Sub

Private Sub Label1b_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 1
End Sub
Private Sub Label2b_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 2
End Sub
Private Sub Label3b_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 3
End Sub
Private Sub Label4b_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 4
End Sub
Private Sub Label5b_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    overColor 5
End Sub

'CLIC
Private Sub Label1b_Click()
    numeroClic = 1
End Sub
Private Sub Label2b_Click()
    numeroClic = 2
End Sub
Private Sub Label3b_Click()
    numeroClic = 3
End Sub
Private Sub Label4b_Click()
    numeroClic = 4
End Sub
Private Sub Label5b_Click()
    numeroClic = 5
End Sub

Private Sub Label1_Click()
    Label1b_Click
End Sub
Private Sub Label2_Click()
    Label2b_Click
End Sub
Private Sub Label3_Click()
    Label3b_Click
End Sub
Private Sub Label4_Click()
    Label4b_Click
End Sub
Private Sub Label5_Click()
    Label5b_Click
End Sub
Le 22/11/2019 à 08:06

Bonjour curulis57, Sébastien,

Merci à vous 2, je me demande qu'elle est vraiment la différence entre un LabelBox et une TextBox, car effectivement quand je regarde les 2 solutions :

@ curulis57: Ta solution fonctionne parfaitement mais je la trouve moins fluide

@ Sébastien: Ta solution fonctionne nickel

Je trouve que les 2 solutions sont programmées de la même manière, mais la fluidité est différente, est ce là la différence entre une TextBox et un LabelBox ?

Encore merci à vous en tout cas pour votre aide.

Le 22/11/2019 à 09:20
Florian53 a écrit :

Je trouve que les 2 solutions sont programmées de la même manière, mais la fluidité est différente, est ce là la différence entre une TextBox et un LabelBox ?

La différence est que la zone de texte permet d'entrer/modifier du texte (essaie de cliquer sur l'une des zones de texte puis tape quelque chose au clavier).

Pour faire un menu, ce n'est tout simplement pas le bon type de contrôle à utiliser.

C'est un peu comme si j'avais utilisé des TextBox pour faire les menus du site

textboxs
Le 22/11/2019 à 09:55

OK, super merci pour tes explications , c'est beaucoup plus clair pour moi et je vais pouvoir avancer dans mon projet. Un grand merci

Le 22/11/2019 à 10:22

Re bonjour,

Est il de modifier le code cette façon:

Le code fonctionne bien mais quand je passe ma souris sur un LabelBox sans cliquer dessus celui ci passe bien au rouge mais reste au rouge même si je positionne ma souris sur un range ou quelque autre part qui n'est pas un LabelBox.

Merci

Le 22/11/2019 à 11:51

Une possibilité (disparition de l'effet après 2 secondes) :

48menu-avec-survol-b.xlsm (40.20 Ko)
Le 22/11/2019 à 13:46

J'ai essayé ton fichier mais j'ai une erreur après les 2 secondes et la procédure "resetColorsTimer" ne se déroule pas

"Impossible d'éxécuter la macro "C:\....... Menu avec survol-b.xlsm'!'"'Feuil7.resetColorsTimer " & dernierTimer & "'". Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactiver."

J'ai essayé plusieurs chose mais le problème persiste:

  • Activer toutes les macros
  • Mettre "Private Sub resetColorsTimer"
  • changer l'écriture "Application.OnTime Now + TimeValue("00:00:02"), "'resetColorsTimer """ & dernierTimer & """'"

Impossible de lancer cette procédure

Le 22/11/2019 à 14:54

Salut Florian,

Salut Sébastien,

une solution : intégrer les Label 1-5 dans un Label qui fait office de cadre qui peut, lui aussi, intercepter l'événement MouseMove.

Cela dit, contrairement à VB avec lequel on pouvait jouer à l'infini, les cellules d'Excel n'interceptent pas cet événement donc, si tu fais un déplacement brusque entre les Labels et les cellules, il y a des chances que l'événement ne soit pas intercepté.

A toi d'agir en bon père de famille pour ne pas saboter ton propre processus!

A+

37florian-mousemove.xlsm (32.56 Ko)
Le 22/11/2019 à 16:02
Florian53 a écrit :

J'ai essayé ton fichier mais j'ai une erreur après les 2 secondes et la procédure "resetColorsTimer" ne se déroule pas

"Impossible d'éxécuter la macro "C:\....... Menu avec survol-b.xlsm'!'"'Feuil7.resetColorsTimer " & dernierTimer & "'". Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactiver."

Chez moi ça fonctionne très bien ...

Le problème est en fait dû au séparateur de décimales (tu dois avoir la , comme séparateur de décimale).

A tester :

25menu-avec-survol-c.xlsm (40.26 Ko)
curulis57 a écrit :

une solution : intégrer les Label 1-5 dans un Label qui fait office de cadre qui peut, lui aussi, intercepter l'événement MouseMove.

Cela dit, contrairement à VB avec lequel on pouvait jouer à l'infini, les cellules d'Excel n'interceptent pas cet événement donc, si tu fais un déplacement brusque entre les Labels et les cellules, il y a des chances que l'événement ne soit pas intercepté.

C'est une très bonne option aussi pour laquelle il ne faut pas avoir peur d'ajouter un Label aussi large que nécessaire pour être sûr de ne pas manquer la "sortie".

L'astuce pour éviter d'être ensuite gêné par un gros Label quand on n'utilise pas le menu est de l'afficher uniquement au survol (c'est la technique que j'avais utilisée ici : onglet déroulant).

A tester :

44menu-avec-survol-d.xlsm (40.79 Ko)

Cordialement,

Le 24/11/2019 à 17:32

Tip Top , Merci Sébastien, la solution "d" me parait mieux visuellement car il n'y a pas de phénomène de Label blanc quand on clique dessus comparé à la solution "c".

Encore un grand merci à toi.

Rechercher des sujets similaires à "colorisation textbox activex mousemove"