XL 2019 Changer la couleur de fond cellule après une recherche

[AIXELS]

Bonjour à tous les amis du Forum.
Mon problème est le suivant :
Faire une recherche dans le tableau en VBA.
Une fois la donnée trouvée, faire changer la
couleur du fond 2 ou 3 fois pour attirer l'attention
ensuite remettre le fond dans sa couleur initiale.
Merci pour aide.
Bien cordialement.

 

[Dranreb]

Bonsoir.
Essayez comme ça :

Option Explicit
Private Cel As Range, CoulInit As Long, NbClign As Byte
Sub Recherche()
   Set Cel = Cells.Find(What:="RATO", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
      SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
   CoulInit = Cel.Interior.Color
   Clignote
   End Sub
Sub Clignote()
   If NbClign < 6 Then
      Cel.Interior.Color = IIf(NbClign Mod 2, &HEC00BD, &H6DFFB7)
      NbClign = NbClign + 1
      Application.OnTime Now + TimeSerial(0, 0, 1), "Clignote"
   Else
      Cel.Interior.Color = CoulInit
      NbClign = 0
      End If
   End Sub

 

[AIXELS]

Bonjour @Dranreb et tous les amis du Forum.
Merci pour ta réponse, mais je me suis mal exprimé.
Je vous envoie le code. Code que j'ai glané au fil de mes recherches.
J'ai ajouté de la couleur au résultat de la recherche de la recherche
pour attirer l'œil, le tableau contient de nombreuses cellules.

'ICI C'est la sélection au Double Click & Sortie du UserForm
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    Sheets(CStr(ListBox1.Column(6))).Activate
    Range(ListBox1.Column(7)).Activate
   Unload Me
  
'****************************************************************
'Code à améliorer, pas très pro
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
    
     Application.Wait (Now + TimeValue("0:00:02"))
    
    
      With Selection.Interior
     .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
      
'****************************************************************
      
      
End Sub

Merci pour votre aide.
Bonne journée à tous.
Bien cordialement

 

[Dranreb]

Il n'y a aucun UserForm dans le classeur joint.
Il est aussi possible de mettre une mise en forme conditionnelle sur la ligne dont le numéro est connu dans un nom dans la feuille, celui ci étant rectifié après la recherche.

 

[Dranreb]

Cette version permet de spécifier le cellule à faire clignoter, un peu plus rapidement :

Option Explicit
Private TSRéf As Single, Cel As Range, CoulOrig As Long, NbClig As Byte
Public Sub Clignote(Optional ByVal Rng As Range)
   Dim TS As Single
   TS = VBA.Timer
   If Not Rng Is Nothing Then
      Set Cel = Rng
      If Cel.Interior.ColorIndex = xlColorIndexNone Then CoulOrig = -1 _
         Else CoulOrig = Cel.Interior.Color
      NbClig = 0
      TSRéf = TS - 0.25: End If
   If TS >= TSRéf Then
      NbClig = NbClig + 1
      If NbClig > 10 Then
         If CoulOrig < 0 Then Cel.Interior.ColorIndex = xlColorIndexNone _
            Else Cel.Interior.Color = CoulOrig
         Exit Sub: End If
      Cel.Interior.Color = IIf(NbClig Mod 2, &HFFA5&, &HFF00CC)
      TSRéf = TS + 0.25: End If
   Application.OnTime Now, "Clignote"
   End Sub

Exemple d'appel (depuis un UserForm ou non) :

Clignote ActiveCell

 

[mapomme]

Bonjour @AIXLES, Dranreb et les autres ,

Une procédure générique qui prend en argument une plage (pouvant être une seule cellule) et les paramètres de clignotement. Si la plage est égale à Nothing alors pas de clignotement. La procédure sélectionne la feuille de la plage et la plage elle-même.

Sub FaireClignoter (xrg As Range , couleur1 , couleur2 , nfois , duree ) où:
xrg => la plage dont le fond doit clignoter
couleur1 => couleur 1 du clignotement
couleur2 => couleur 2 du clignotement
nfois => combien d'apparition du couple (couleur1, couleur2)
duree => durée d'affichage d'une seule couleur (en milliseconde)

utilisation : FaireClignoter cible, vbCyan, vbRed, 3, 350 (voir dans procédure Recherche)
Cliquer sur le bouton Hop!

Le code est dans module1:

Sub FaireClignoter(xrg As Range, couleur1&, couleur2&, nfois&, duree&)
' couleur1  =>  couleur 1 du clignotement  -  couleur2  =>  couleur 2 du clignotement
' nfois  =>  combien d'apparition du couple (couleur1, couleur2)
' duree  =>  durée d'affichage d'une seule couleur (en milliseconde)
Dim CouleurOri&      'couleur de fond originelle
Dim T2               'Fin de durée d'affichage d'une couleur
Dim i&
   If xrg Is Nothing Then Exit Sub   'pas cellule, on quitte
   Application.Goto xrg    'on sélectionne la cible
   CouleurOri = xrg.Interior.Color   'couleur originelle de la cible
   With xrg
      For i = 1 To nfois
         .Interior.Color = couleur1: T2 = Timer + duree / 1000
         Do
            DoEvents
         Loop Until Timer >= T2
         .Interior.Color = couleur2
         xrg.Interior.Color = couleur2: T2 = Timer + duree / 1000
         Do
            DoEvents
         Loop Until Timer >= T2
      Next i
      .Interior.Color = CouleurOri
   End With
End Sub

 

[AIXELS]

Bonjour @Dranreb @mapomme et tous les Amis du Forum.
Merci pour vos réponses respectives.
Je vais regarder de plus près et je vous tiens au courant.
Mille mercis pour le temps que vous avez consacré à ma requête.
Bien cordialement.

Une parenthèse pour ma réponse tardive : à chaque fois
que mon PC se met en veille, il se bloque, il faut que j'attende
que la batterie se décharge pour le faire redémarrer.

 

[mapomme]

Une parenthèse pour ma réponse tardive : à chaque fois
que mon PC se met en veille, il se bloque, il faut que j'attende
que la batterie se décharge pour le faire redémarrer.

J'en avais un qui me faisait cela de temps en temps.

Dans ce cas, ce que je faisais en désespoir de cause (pas le temps d d'attendre que la batterie soit à plat):

• appuyer sur le bouton Marche/Arrêt pendant environ 10s. Le micro s'arrêtait. Je pouvais ensuite le redémarrer
• au pire, je le débranchais du secteur et retirer la batterie puis la remettais en place. Je pouvais ensuite le redémarrer

Attention! C'est un arrêt brutal. Le travail en cours sera perdu. Comme quoi, quand on quitte son poste pour quelque razison que ce soit, on sauvegarde les fichiers sur lesquels on travaille. C'est fastidieux mais oh combien de fois m'en suis-je félicité.

Le mieux est de trouver la cause du phénomène. Gogole doit pourvoir aider...

 

[AIXELS]

Re

• au pire, je le débranchais du secteur et retirer la batterie puis la remettais en place. Je pouvais ensuite le redémarrer

Malheureusement la batterie n'est pas accessible, il faut démonter le capot.
Avec mon ancien portable, je pouvais le faire, la batterie était amovible.

 

[Dranreb]

J'ai révisé mon module de clignotement :

Option Explicit
Private TSRéf As Single, Cel As Range, CoulOrig As Long, NbClign As Byte
Public Sub FaireClignoter(ByVal Rng As Range)
   If Cel Is Nothing Then
      Application.OnTime Now, "Clignote"
   Else: Rétablir: End If
   Set Cel = Rng
   If Cel.Interior.ColorIndex = xlColorIndexNone Then CoulOrig = -1 _
      Else CoulOrig = Cel.Interior.Color
   NbClign = 0
   Cel.Interior.Color = &HFFA5&
   TSRéf = VBA.Timer
   End Sub
Private Sub Clignote()
   Dim TS As Single
   TS = VBA.Timer
   If TS >= TSRéf Then
      NbClign = NbClign + 1
      If NbClign > 10 Then Rétablir: Exit Sub
      Cel.Interior.Color = IIf(NbClign Mod 2, &HFFA5&, &HFF90DC)
      TSRéf = TS + 0.25: End If
   DoEvents
   Application.OnTime Now, "Clignote"
   End Sub
Private Sub Rétablir()
   If CoulOrig < 0 Then
      Cel.Interior.ColorIndex = xlColorIndexNone
   Else: Cel.Interior.Color = CoulOrig: End If
   Set Cel = Nothing
   End Sub

Il se déroule toujours en tâche de fond, mais ça ne plante plus quand on lance un clignotement avant que celui d'une autre cellule soit terminé (eh oui, ça plantait, ça …), ça arrête proprement le précédent.

 

[AIXELS]

Bonjour @Dranreb et tous les amis du Forum.
Merci pour ta réponse.
J'ai un message d'erreur que je joint.
Où dois-je placer dans la macro l'appel de :

Clignote ActiveCell

Et tout le code que tu as envoyé ?
Merci pour ton aide. Bien cordialement.

 

[Dranreb]

Bonjour.
Avec le nouveau module c'est devenu :

FaireClignoter LExpressionRangeReprésentantLaCelluleÀFaireClignoter

À mettre là où on veut lancer le clignotement. N'arrête pas l'exécution.

 

[AIXELS]

Re @Dranreb
J'ai un message d'erreur ci-joint.
Bien cordialement.

 

[Dranreb]

Active n'existe pas et n'est donc pas muni d'une propriété Cell.
Déclarez donc plutôt une variable As Range. Dans les macros c'est rarement utile de sélectionner quelque chose. À la rigueur à la fin, juste avant la End Sub, si on veut que ce le soit à l'intention de l'opérateur.

 

[AIXELS]

Une fois la valeur recherchée trouvée, la macro s'arrête
sur la cellule de la valeur cherchée.
C'est cette que je voudrais faire clignoter pour attirer
l'attention.