XL 2016 Faire clignoté une celule

bruceletoutpuisent

XLDnaute Nouveau
Bonjour l'équipe


Voilà, j'ai un tableau avec beaucoup de référence dans plusieurs secteurs de mon bâtiment.

J'ai effectué un référencement de mes stocks sur ce tableau avec leur emplacement jusque la tout va bien , mais je cherche à faire clignoter les références sur ce tableau quand je cherche une ref.


Exemple : je cherche la référence 3000x300x300 une fois la recherche effectuée, je trouve bien son emplacement depuis mon tableau , ce que je n'arrive pas à faire une fois la recherche trouvé, c'est de la faire clignoter en rouge, le résulta 300x300x300 . Donc, pour chaque recherche trouvée, je souhaite la faire clignoter pour plus de visualiser, pour des malvoyants qui travaillent avec moi, pour leur simplifier la vie dans l'entreprise.

je cherche une âme charitable pour finalisé le projet .

Joint le fichier


merci d'avance
 

Pièces jointes

  • EMBAL001.xlsx
    30.8 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour bruceletoutpuisent, JM,

Si quelqu'un n'a pas trouvé son bonheur voyez le fichier joint et ce code :
VB:
Dim t# 'mémorise la variable

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim periode#, cherche$, c As Range, P As Range
periode = 1 'en secondes, à adapter
Arret
Cells.FormatConditions.Delete 'supprime la MFC
cherche = "*" & LCase(CStr([B1])) & "*"
If cherche = "**" Then Exit Sub
For Each c In UsedRange
    If LCase(CStr(c)) Like cherche Then Set P = Union(IIf(P Is Nothing, c, P), c)
Next
If P Is Nothing Then Exit Sub
P.FormatConditions.Add xlExpression, Formula1:="=Couleur" 'crée la MFC
P.FormatConditions(1).Interior.Color = 0 'fond noir
P.FormatConditions(1).Font.Color = 15921906 'police blanche
P.FormatConditions(1).Font.Bold = True 'gras
t = Timer
Do
    ThisWorkbook.Names.Add "Couleur", True 'nom défini
    If t = 100000 Then Exit Do 'arrêt
    t = Timer
    While t + periode < 86400 And Timer < t + periode / 2: DoEvents: Wend
    ThisWorkbook.Names.Add "Couleur", False 'nom défini
    While t + periode < 86400 And Timer < t + periode: DoEvents: Wend
Loop
End Sub

Sub Arret()
t = 100000
End Sub

Sub Effacer()
t = 100000
[B1] = ""
Cells.FormatConditions.Delete 'supprime la MFC
End Sub
A+
 

Pièces jointes

  • EMBAL001(1).xlsm
    48.4 KB · Affichages: 14
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 892
Membres
101 831
dernier inscrit
gillec