Discussion :

[EAU24]

Bonjour à, tous,
Je vous communique ci-dessous un code

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
 
Public Tempo As Date
Sub clignotant()
Dim R As Range
Dim l As Long
Set R = ActiveSheet.UsedRange
For l = 2 To R.Rows.Count
    If R(l, 1) = Date Then
        R(l, 1).Offset(0, 1) = ""
    Else
        R(l, 1).Offset(0, 1) = "Attention!"
        R(l, 1).Offset(0, 1).Font.Bold = True
        R(l, 1).Offset(0, 1).Font.Color = -16776961
        If R(l, 1).Offset(0, 1).Font.Size = 11 Then R(l, 1).Offset(0, 1).Font.Size = 20 Else R(l, 1).Offset(0, 1).Font.Size = 11
 
    End If
  DoEvents
Next
Tempo = Now + TimeValue("00:00:01")
Application.OnTime Tempo, "clignotant"
End Sub

Je voudrais que la cellule clignote pendant seulement 1 minute et ensuite s'arrête toute seule sans intervention de ma part.
Merci pour votre aide (je pense notamment à ARTURO83)

[Menhir]

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
Sub clignotant()
    Dim Plage As Range
    Dim R As Range
 
    Set Plage = Intersect(ActiveSheet.UsedRange, Columns(1))
    For Each R In Plage
        With R.Offset(0, 1)
        If R.Value = Date Then
            .Value = IIf(.Row=1, .Value, "")
        Else
            .Value = "Attention!"
            .Font.Bold = True
            .Font.Color = -16776961
        End If
    Next R
    Call clignotantNext(Now() + TimeValue("00:01:00"))
End Sub
 
Sub clignotantNext(Fin As Date)
    Dim Plage As Range
    Dim R As Range
    Dim Tempo As Date
 
    Set Plage = Intersect(ActiveSheet.UsedRange, Columns(1))
    For Each R In Plage
        If R.Value <> Date And R.Row > 1 Then R.Offset(0, 1).Font.Size = 31 - R.Offset(0, 1).Font.Size
    Next R
    DoEvents
    Tempo = Now + TimeValue("00:00:01")
    If Tempo < Fin Then Application.OnTime Tempo, "clignotantNext(" & Fin & ")"
End Sub

[Zekraoui_Jakani]

J'aime bien la solution proposée par Menhir, et j'avais préparé aussi presque en même temps une solution plutôt intuitive:

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
Private Sub CommandButton1_Click()  'lié à un bouton créé sur ActiveSheet
    NewClignotant
End Sub
 
Sub NewClignotant()
 
    Dim R As Range
    Dim j As Long
    Dim freq As Long: freq = 240    'à faire varier à souhait
 
    Set R = ActiveSheet.UsedRange
 
    For j = 2 To R.Rows.Count
        If R(j, 1) = Date Then
        R(j, 1).Offset(0, 1) = ""
        Else
            With R(j, 1).Offset(0, 1)
                .Value = "Attention!"
                .Font.Bold = True
                .Font.Color = -16776961
                If .Font.Size = 11 Then .Font.Size = 20
            End With
        End If
 
        For k = 1 To freq
            R(j, 1).Offset(0, 1).NumberFormat = ";;;"
            DoEvents
            R(j, 1).Offset(0, 1).NumberFormat = "General"
        Next k
    Next j
 
End Sub

[EAU24]

J'ai un message d'erreur dans un MsgBox lorsque j'applique tel quel le Code de Menhir:

Erreur de compilation
Next sans For

OK Aide

Que fais-je ?
EAU24

[Menhir]

J'ai un message d'erreur dans un MsgBox lorsque j'applique tel quel le Code de Menhir:

Que fais-je ?

Bin... tu essayes de débuguer.

Et tu commences par virer le On Error qui se trouve certainement dans ton code et qui empêche de savoir sur quelle ligne se produit le bug.

[EAU24]

Bin... tu essayes de débuguer.

Et tu commences par virer le On Error qui se trouve certainement dans ton code et qui empêche de savoir sur quelle ligne se produit le bug.

J'ai pas dans le code "On Error" désoled....

[Menhir]

J'ai pas dans le code "On Error" désoled....

Alors comment se fait-il que les messages d'erreur s'ouvrent dans une MsgBox ?

[Pierre Fauconnier]

Salut.

Si tu as des On Error... dans ton code (ce que je n'ai pas vu mais qui a été suggéré), il est préférable d'apprendre à bien les coder plutôt que les virer

Indente ton code, ce sera plus clair pour identifier les blocs... (décaler vers la droite les lignes qui font partie d'un bloc...)

[EAU24]

Salut.

Si tu as des On Error... dans ton code (ce que je n'ai pas vu mais qui a été suggéré), il est préférable d'apprendre à bien les coder plutôt que les virer

Indente ton code, ce sera plus clair pour identifier les blocs... (décaler vers la droite les lignes qui font partie d'un bloc...)

Bonsoir,
Le Code que j'ai affiché (avec des #) tout en haut, fonctionne très bien. Mais je dois créer deux boutons : un pour lancer l'application l'autre pour stop l'application.
Donc pour revenir à ma première question : je souhaite supprimer le bouton "Stop" et que le clignotement une fois lancée s'arrête tout seul au bout d'une minute.

C'est pas compliqué...
Merci

[Pierre Fauconnier]

@Menhir,

Il manque End With juste avant Next R. Le msgbox dont parle Eau24 est le message qui s'affiche à cause de cette ligne manquante. De plus, ton code bogue chez moi au premier appel récursif de ClignotantNext. Voici ce que dit l'aide sur OnTime : Procedure ne doit prendre aucun argument et ne peut pas être déclarée dans une classe ou un formulaire personnalisé.

Ce code a-t-il été testé?

@Zekraoui,

Il manque la déclaration de la variable k, le code a-t-il été testé avec Option Explicit?

[Pierre Fauconnier]

Voilà la solution de menhir corrigée, à l'aide d'une variable publique

Code vba :

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
Dim Fin As Date
 
Sub clignotant()
    Dim Plage As Range
    Dim R As Range
 
    Set Plage = Intersect(ActiveSheet.UsedRange, Columns(1))
    For Each R In Plage
        With R.Offset(0, 1)
          If R.Value = Date Then
              .Value = IIf(.Row = 1, .Value, "")
          Else
              .Value = "Attention!"
              .Font.Bold = True
              .Font.Color = -16776961
          End If
        End With
    Next R
    Fin = Now() + TimeValue("00:01:00")
    Call clignotantNext
End Sub
 
Sub clignotantNext()
    Dim Plage As Range
    Dim R As Range
    Dim Tempo As Date
 
    Set Plage = Intersect(ActiveSheet.UsedRange, Columns(1))
    For Each R In Plage
        If R.Value <> Date And R.Row > 1 Then R.Offset(0, 1).Font.Size = 31 - R.Offset(0, 1).Font.Size
    Next R
    DoEvents
    Tempo = Now + TimeValue("00:00:01")
    If Tempo < Fin Then Application.OnTime Tempo, "clignotantNext"
End Sub

J'espère n'avoir jamais à travailler avec un truc qui me fait cela à l'écran, ceci dit...

A cause de l'utilisation de la variable publique (que perso je n'aime pas utiliser) dans la solution de menhir, je préfère celle de Zakraoui.

Sur le fond, je me pose la question de l'utilité de faire clignoter une cellule ou une plage de cellules dans Excel (bonjour les yeux), surtout pendant 1 minute. C'est exagérément long, 1 minute.

[Patrice740]

Bonjour Pierre,

Sur le fond, je me pose la question de l'utilité de faire clignoter une cellule ou une plage de cellules dans Excel (bonjour les yeux), surtout pendant 1 minute. C'est exagérément long, 1 minute.

C'est bientôt Noël ... cette année on va manquer de sapins à cause de la sécheresse

Outre les variables publiques, j'évite aussi les objets actifs (ici Activesheet), en 1 minute, on peut changer de feuille avec des conséquences inattendues.

[Menhir]

Entièrement d'accord avec vous deux.
Les possibilités des mises en forme conditionnelles sont largement suffisantes pour mettre en évidence des cellules sans se compliquer la vie avec de pareilles acrobaties.

[EAU24]

Grand Merci à Pierre Fauconnier.
Je rentre de voyage et avec le décalage horaire c'est pas facile.
Cela fonctionne. Mais si je veux introduire un Private Sub Worksheet_Change (ByVal Target As Range) pour que le module se mette en route lorsque la date indiquée n'est pas celle du système.
il ne se passe rien.
Merci encore
EAU24

[Menhir]

Cela fonctionne. Mais si je veux introduire un Private Sub Worksheet_Change (ByVal Target As Range) pour que le module se mette en route lorsque la date indiquée n'est pas celle du système.
il ne se passe rien.

Si tu ne montres pas le code que tu utilises, difficile de savoir où se trouve le problème.

[EAU24]

Le Code est en haut, c'est celui de Pierre Fauconnier.
EAU24