Alarmes imbriquées.

Commenter

Contenu du snippet

Imbriquons plusieurs alarmes les unes dans les autres afin que s'affiche en clignotant l'heure du système, avec des couleurs qui changent selon des critères prédéfinis de temps et avec la survenue d'alarmes à intervalles réguliers.

Source / Exemple : 


'A placer dans Thisworkbook :
' penser à créer un Userform nommé Alarm avec juste du texte dedans
Private Sub Workbook_Open()
    HeureActivée = 1
        TpsPassé = 0
        Timer
        clHeure = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 5) 'Première alarme ds 5s !
        scanClavier 'vérifions que personne n'appuie sur la touche Q !
End Sub

'Puis le reste à placer dans un module standard :
'Déclaration des variables
Dim TimerID As Long
Public HeureActivée As Boolean
Dim Ttes1s, Ttes10s
Public clHeure, cpluslHeure
Public TpsPassé As Integer

Sub Timer()
' Affiche les formats choisis et envoie les déclenchements d'événements
    If HeureActivée Then
        TpsPassé = TpsPassé + 1
        If TpsPassé = 1 Then 'chaque seconde, on écrit en noir sur fond blanc
            With [lheure]
                .Value = Time
                .Interior.ColorIndex = 2
                .Font.ColorIndex = 1
            End With
        ElseIf TpsPassé = 2 Then 'mais une fois sur 2, on inverse les couleurs
            With [lheure]
                .Value = Replace(Time, ":", ".")
                .Interior.ColorIndex = 1
                .Font.ColorIndex = 2
            End With
            TpsPassé = 0
        End If
        Application.OnTime clHeure, "AlarmeOn", False 
        Ttes1s = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 1)
        If Second(Time) < 50 Then
            Ttes10s = TimeSerial(Hour(Time), Minute(Time), Int(Second(Time) / 10 + 1) * 10)
        Else
            Ttes10s = TimeSerial(Hour(Time), Minute(Time) + 1, 0)
        End If
        If Int(Second(Time) / 10 + 1) * 10 Mod 10 = 0 Then Application.OnTime Ttes1s, "Timer", False
        Application.OnTime Ttes10s, "Timer2", False
    End If
End Sub

Sub Timer2()
'Ben si les secondes sont rondes, un format de couleur spécial est appliqué
    If HeureActivée Then
        If Second(Time) < 1 Then
            [lheure].Interior.Color = RGB(255, 0, 0) 'rouge si secondes = 0
        Else
            [lheure].Interior.Color = RGB(0, 255, 0) 'vert si secondes= 10,20,30,40, ou 50
        End If
        'Timer
    End If
End Sub

Sub AlarmeOn()
'C'est l'heure de l'alarme
    If HeureActivée Then
    Beep
    Load Alarm 'userform du nom de Alarm à créer (j'ai écrit dedans : c'est l'heure
    Alarm.Show vbModeless
    cpluslHeure = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 3) 'l'alarme reste affichée 3s
    clHeure = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 17) ' et elle se renouvelle ttes les 17s...à modifier si tu veux !
    Application.OnTime cpluslHeure, "AlarmeOff", False
    End If
End Sub

Sub alarmeOff()
'on dégage la fenêtre d'alarme
    Unload Alarm
End Sub

Sub scanClavier()
'on lance/arrête la mise à jour de l'affichage de l'heure avec Q
    Application.OnKey ("q"), "OnOff"
End Sub

Sub OnOff()
'Q arrête ou lance OnOFF
    HeureActivée = Not HeureActivée
    If HeureActivée Then
        TpsPassé = 0
        Timer
        clHeure = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 5) 'La nouvelle alarme, ds 5s !
    End If
End Sub

Conclusion :


A adapter selon tes besoins

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Softmama)