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
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir

bruceletoutpuissant
Regarde les âmes charitables qui t'attendent tout en bas de la page
(dans les Discussions similaires)
;)
 

Staple1600

XLDnaute Barbatruc
Re

Et tu y as trouvé ton bonheur dans cette "foule" de clignotements de cellules ? ;)

EDITION: Bonjour job75
 
Dernière édition:

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+
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
J'ai un peu modifié le code précédent avec l'instruction t = 100000, utilisez bien le bon fichier.
 

Discussions similaires


Haut Bas