Discussion :

[CALIDENIS]

Bonjour,

Je souhaite créer une macro pour faire clignoterdes cellules sous condition:
Si montant supérieur à 500, alors clignoter.

Par avance, merci pour votre aide.

PS: Je vous joins mon fichier

Cordialement

[PMO2017]

Bonjour,

Une piste avec le code ci-après.

1) Copiez le code suivant dans un module Standard

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Const LIMITE_PASSAGES As Long = 6 'on limite à 6 passages (à adapter)
 
'--- Portée publique ---
Public MesCellules As Range
Public NonFaire As Boolean
'--- Portée Module ---
Dim bool As Boolean
 
 
Sub Clignote(Optional dummy As Byte)
Static NbPasse&
Dim C As Range
Dim temps
Dim Couleur&
'---
NonFaire = True
NbPasse& = NbPasse& + 1
'---
If Not bool Then
  Couleur& = 6
Else
  Couleur& = 2
End If
If NbPasse& > LIMITE_PASSAGES Then Couleur& = 2
'---
For Each C In MesCellules
  C.Interior.ColorIndex = Couleur&
Next C
bool = Not bool
'---
If NbPasse& <= LIMITE_PASSAGES Then
  temps = Now + TimeValue("00:00:01")
  Application.OnTime EarliestTime:=temps, Procedure:="clignote"
Else
  bool = False
  NonFaire = False
  NbPasse& = 0
End If
End Sub

2) Copiez le suivant dans la fenêtre de code de la feuille concernée (dans votre pièce jointe "Feuil2")

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Const MONTANT_SUP As Double = 500 'à adapter
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage As Range
Dim R As Range
Dim C As Range
'---
If Not NonFaire Then
  Set Plage = Range("c10:c" & [a65536].End(xlUp).Row & "")
  For Each C In Plage
    If IsNumeric(C) Then
      If C > MONTANT_SUP Then
        If R Is Nothing Then
          Set R = C
        Else
          Set R = Application.Union(R, C)
        End If
      End If
    End If
  Next C
  If Not R Is Nothing Then
    Set MesCellules = R
    Call Clignote
  End If
End If
'---
End Sub

Un changement de sélection sur la "Feuil2" lance l'évènement Worksheet_SelectionChange qui traite le clignotement.