|
Déclenchement du son "Alerte.wav" (présent dans le dossier) toutes les 5 secondes...pour les minutes Il faut modifier le paramètre "délai" dans la macro
'************************************
'partie à coller dans Thisworboock
'************************************
Option Explicit
' Ti et Vériland Décembre 2003
' Petite procédure pour fermer
' le prog sans l'enregistrer
Private Sub Workbook_BeforeClose(Cancel As Boolean)
SupprimeInterruption
Application.DisplayAlerts = False
With ThisWorkbook
.Close
End With
Application.DisplayAlerts = True
End Sub
'il vaut mieux privilégier l'événement Workbook_Open
'à une macro Auto_Open
Private Sub Workbook_Open()
Programmation
End Sub
'************************************
'partie à coller dans un module
'************************************
Option Explicit
'Ti Décembre 2003
'Déclaration pour avoir du son WAV
Private Declare Function PlaySound32 Lib "winmm.dll" Alias "PlaySoundA" (ByVal IpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Public MusicWAV
'Delai est le temps d'inactivité en secondes
'on peut le définir en minutes il suffit de changer
'Heure = Now + TimeValue("00:& Delai &":00" )
'plus bas
Const Delai = 5
Sub Programmation()
Dim Heure As Date
Heure = Now + TimeValue("00:00:" & Delai)
'on sauvegarde l'heure de la dernière programmation pour éventuellement
'pouvoir la supprimer à la fermeture du fichier
ThisWorkbook.Names.Add Name:="ChronoTime", RefersTo:=Heure
ThisWorkbook.Names.Add Name:="Chrono", RefersTo:=0
Application.OnTime Heure, "Interruption"
End Sub
Private Sub Interruption()
With ThisWorkbook
If .Sheets(1).Evaluate("Chrono") = 0 Then
MusicWAV = ThisWorkbook.Path & "\Alerte.wav"
PlayWAV
ThisWorkbook.Names.Add Name:="ChronoTime", RefersTo:=0
Programmation
Else
Programmation
End If
End With
End Sub
Sub SupprimeInterruption()
'supprime le timer à la fermeture du fichier, s'il ne l'est pas déjà.
'Sinon le fichier risque de se rouvrir tout seul !
Dim Heure As Date
On Error Resume Next
Heure = ThisWorkbook.Sheets(1).Evaluate("ChronoTime")
Application.OnTime Heure, "Interruption", schedule:=False
End Sub
' pour le son
Sub PlayWAV()
Call PlaySound32(MusicWAV, 0&, SND_ASYNC Or SND_FILENAME)
End Sub
Date de création : 24/05/2005 - 19:07
Dernière modification : 25/05/2005 - 22:19
Catégorie : Evènements
Page lue 4024 fois
 Prévisualiser la page
 Imprimer la page
|
|
OOo
OOo
Membres: 1660
Membre en ligne: 0
Anonymes en ligne: 41
Haut 
