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
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
Bonjour,
Une piste avec le code ci-après.
1) Copiez le code suivant dans un module Standard
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
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
Un changement de sélection sur la "Feuil2" lance l'évènement Worksheet_SelectionChange qui traite le clignotement.
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
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager